bartronx7/guix
1
0
Fork 0
mirror of https://codeberg.org/guix/guix.git synced 2026-01-25 03:55:08 -06:00
Code Issues Projects Releases Packages Wiki Activity Actions

DRAFT system: Add (gnu system bootstrap).

Browse source 
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.
This commit is contained in:
Ludovic Courtès 2019-12-06 23:58:10 +01:00
parent 18c10b055e
commit de340bd1f2
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 192 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
gnu/local.mk
View file

@ -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 \

191
gnu/system/bootstrap.scm Normal file
View file

@ -0,0 +1,191 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Ludovic Courtès <ludo@gnu.org>
;;;
;;; 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 <http://www.gnu.org/licenses/>.
(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))