1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
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))
|
