;;; 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))