From de340bd1f2b43b7a1c04ab5c4d555ce9ab8f7881 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 6 Dec 2019 23:58:10 +0100 Subject: DRAFT system: Add (gnu system bootstrap). This allows us to perform arbitrary builds on a system that has no userland besides the build process itself, running as PID 1. Suggested by Vagrant Cascadian. DRAFT: The resulting system does build things, but this is all happening into memory, which may or may not be a problem (it allows us to not have disk drivers in the kernel!). More importantly, it does not display anything upon completion, and the build result is lost as well. * gnu/system/bootstrap.scm: New file. * gnu/local.mk (GNU_SYSTEM_MODULES): Add it. --- gnu/local.mk | 1 + gnu/system/bootstrap.scm | 191 +++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 192 insertions(+) create mode 100644 gnu/system/bootstrap.scm diff --git a/gnu/local.mk b/gnu/local.mk index 83bba6b644..3d54f7cfee 100644 --- a/gnu/local.mk +++ b/gnu/local.mk @@ -593,6 +593,7 @@ GNU_SYSTEM_MODULES = \ %D%/system/shadow.scm \ %D%/system/uuid.scm \ %D%/system/vm.scm \ + %D%/system/bootstrap.scm \ \ %D%/machine.scm \ %D%/machine/digital-ocean.scm \ diff --git a/gnu/system/bootstrap.scm b/gnu/system/bootstrap.scm new file mode 100644 index 0000000000..c6eb10616e --- /dev/null +++ b/gnu/system/bootstrap.scm @@ -0,0 +1,191 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2019 Ludovic Courtès +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see . + +(define-module (gnu system bootstrap) + #:use-module (guix gexp) + #:use-module (guix modules) + #:use-module ((guix packages) #:select (default-guile)) + #:use-module ((guix self) #:select (make-config.scm)) + #:use-module (gnu packages bootstrap) + #:use-module (gnu system) + #:use-module (gnu system shadow) + #:use-module (gnu system file-systems) + #:use-module (gnu system linux-initrd) + #:use-module (gnu bootloader) + #:use-module (gnu bootloader grub) + #:use-module (ice-9 match)) + +;;; Commentary: +;;; +;;; This file provides tooling to build an operating system image that builds +;;; a set of derivations straight from the initrd. This allows us to perform +;;; builds in an environment where the trusted computing base (TCB) has been +;;; stripped from guix-daemon, shepherd, and other things. +;;; +;;; Run "guix system vm gnu/system/bootstrap.scm" to get a VM that runs this +;;; OS (pass "-m 5000" or so so it has enough memory), or use "guix system +;;; disk-image", write it to a USB stick, and get it running on the bare +;;; metal! +;;; +;;; Code: + +(define* (build-script obj #:key (guile (default-guile))) + "Return a build script that builds OBJ, an arbitrary lowerable object such +as a package, and all its dependencies. The script essentially unrolls the +build loop normally performed by 'guix-daemon'." + (define select? + ;; Select every module but (guix config) and non-Guix modules. + (match-lambda + (('guix 'config) #f) + (('guix _ ...) #t) + (_ #f))) + + (define fake-gcrypt-hash + ;; Fake (gcrypt hash) module: since (gcrypt hash) is pulled in and not + ;; actually used, plus GUILE may be a statically-linked Guile not capable + ;; of loading libgcrypt, it's OK to just provide a phony module. + (scheme-file "hash.scm" + #~(define-module (gcrypt hash) + #:export (sha1 sha256)))) + + (define emit-script + (with-imported-modules `(((guix config) => ,(make-config.scm)) + ((gcrypt hash) => ,fake-gcrypt-hash) + + ,@(source-module-closure + `((guix derivations)) + #:select? select?)) + #~(begin + (use-modules (guix derivations) + (srfi srfi-1) + (ice-9 match) + (ice-9 pretty-print)) + + (define drv + ;; Load the derivation for OBJ. + (read-derivation-from-file #$(raw-derivation-file obj))) + + (define (derivation->script drv) + ;; Return a snippet that "manually" builds DRV. + `(begin + ;; XXX: Drop part of DRV's file name to not cause the + ;; daemon to detect the reference and go wrong ("path `%1%' + ;; is not valid"). + (format #t "~%~%build-started ...~a~%~%" + ,(string-drop (basename + (derivation-file-name + drv)) + 10)) + + ;; XXX: Use the same directory name as the daemon? + (mkdir-p "/tmp/guix-build") + (chdir "/tmp/guix-build") + (environ ',(map (match-lambda + ((key . value) + (string-append key "=" value))) + (derivation-builder-environment-vars drv))) + (let ((result (system* ,(derivation-builder drv) + ,@(derivation-builder-arguments + drv)))) + (chdir "/") + (delete-file-recursively "/tmp/guix-build") + (zero? result)))) + + (define graph + ;; Closure of the derivation for OBJ. This does _not_ contain + ;; fixed-output derivations, but it contains sources. + (filter-map (lambda (file) + (and (string-suffix? ".drv" file) + (let* ((drv (read-derivation-from-file file)) + (out (derivation->output-path drv))) + ;; GUILE itself is already in the initrd + ;; because it's executing this program. + ;; Thus, don't try to "build" it again. + (and (not (string=? out #$guile)) + drv)))) + (call-with-input-file #$(raw-derivation-closure obj) + read))) + + ;; Emit a script that builds OBJ and all its + ;; dependencies sequentially. + (call-with-output-file #$output + (lambda (port) + (format port "#!~a/bin/guile --no-auto-compile~%!#~%" #$guile) + (pretty-print '(begin + (use-modules (srfi srfi-1) + (ice-9 rdelim)) + + ;; Ensure the script refers to all the + ;; sources of OBJ. + (define these-are-the-sources-we-need + '#$(object-sources obj)) + (primitive-load + #$(local-file "../../guix/build/utils.scm"))) + port) + (newline port) + (pretty-print `(and ,@(map derivation->script graph) + (begin + (format #t "~%Congratulations!~%") + (sleep 3600))) + port) + ;; TODO: Print a hash or something at the end? + (chmod port #o555)))))) + + (computed-file "build.scm" emit-script + #:guile guile)) + +(define (bootstrapping-os obj) + "Return an operating system that starts building OBJ and all its +dependencies, from scratch, as it boots." + (operating-system + (host-name "komputilo") + (timezone "Africa/Casablanca") + (locale "en_US.UTF-8") + + (bootloader (bootloader-configuration + (bootloader grub-bootloader) + (target "/dev/sdX"))) + ;; TODO: Use a minimal Linux-libre kernel. + (file-systems (cons (file-system + (device (file-system-label "my-root")) + (mount-point "/") + (type "ext4")) + %base-file-systems)) + + ;; Network access and all that are not needed. + (firmware '()) + + (users (cons (user-account + (name "vagneke") + (comment "The Bootstrapper") + (group "users")) + %base-user-accounts)) + + ;; Use a special initrd that builds it all! The initrd contains the + ;; script returned by 'build-script' and all its dependencies, which + ;; includes all the source code (tarballs) necessary to build them. + (initrd (lambda (fs . rest) + (expression->initrd + #~(execl #$(build-script obj #:guile %bootstrap-guile) + "build") + #:guile %bootstrap-guile))))) + +;; This operating system builds MES-BOOT from scratch. That currently +;; requires ~5 GiB of RAM. TODO: Should we mount a root file system on a hard +;; disk or...? +(bootstrapping-os (@@ (gnu packages commencement) mes-boot)) -- cgit v1.2.3