Commit | Line | Data |
---|---|---|
04086015 LC |
1 | ;;; GNU Guix --- Functional package management for GNU |
2 | ;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org> | |
3 | ;;; | |
4 | ;;; This file is part of GNU Guix. | |
5 | ;;; | |
6 | ;;; GNU Guix is free software; you can redistribute it and/or modify it | |
7 | ;;; under the terms of the GNU General Public License as published by | |
8 | ;;; the Free Software Foundation; either version 3 of the License, or (at | |
9 | ;;; your option) any later version. | |
10 | ;;; | |
11 | ;;; GNU Guix is distributed in the hope that it will be useful, but | |
12 | ;;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 | ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 | ;;; GNU General Public License for more details. | |
15 | ;;; | |
16 | ;;; You should have received a copy of the GNU General Public License | |
17 | ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. | |
18 | ||
19 | (define-module (gnu system vm) | |
93d44bd8 | 20 | #:use-module (guix config) |
04086015 LC |
21 | #:use-module (guix store) |
22 | #:use-module (guix derivations) | |
23 | #:use-module (guix packages) | |
9f84f12f LC |
24 | #:use-module ((gnu packages base) |
25 | #:select (%final-inputs | |
26 | guile-final gcc-final glibc-final | |
27 | coreutils findutils grep sed)) | |
1b89a66e LC |
28 | #:use-module (gnu packages guile) |
29 | #:use-module (gnu packages bash) | |
04086015 LC |
30 | #:use-module (gnu packages qemu) |
31 | #:use-module (gnu packages parted) | |
5b16ff09 | 32 | #:use-module (gnu packages zile) |
04086015 LC |
33 | #:use-module (gnu packages grub) |
34 | #:use-module (gnu packages linux) | |
35 | #:use-module (gnu packages linux-initrd) | |
30f25b03 | 36 | #:use-module (gnu packages package-management) |
04086015 LC |
37 | #:use-module ((gnu packages make-bootstrap) |
38 | #:select (%guile-static-stripped)) | |
a843fe22 | 39 | #:use-module (gnu packages system) |
0ded70f3 LC |
40 | |
41 | #:use-module (gnu system shadow) | |
42 | #:use-module (gnu system linux) | |
43 | #:use-module (gnu system grub) | |
4646e30a | 44 | #:use-module (gnu system dmd) |
0ded70f3 | 45 | |
ca85d7bc | 46 | #:use-module (srfi srfi-1) |
04086015 LC |
47 | #:use-module (srfi srfi-26) |
48 | #:use-module (ice-9 match) | |
0ded70f3 | 49 | |
04086015 | 50 | #:export (expression->derivation-in-linux-vm |
aedb72fb LC |
51 | qemu-image |
52 | system-qemu-image)) | |
04086015 LC |
53 | |
54 | \f | |
55 | ;;; Commentary: | |
56 | ;;; | |
57 | ;;; Tools to evaluate build expressions within virtual machines. | |
58 | ;;; | |
59 | ;;; Code: | |
60 | ||
2455085a | 61 | (define* (expression->derivation-in-linux-vm store name exp |
04086015 | 62 | #:key |
2455085a LC |
63 | (system (%current-system)) |
64 | (inputs '()) | |
04086015 LC |
65 | (linux linux-libre) |
66 | (initrd qemu-initrd) | |
50731c51 | 67 | (qemu qemu/smb-shares) |
04086015 LC |
68 | (env-vars '()) |
69 | (modules '()) | |
70 | (guile-for-build | |
71 | (%guile-for-build)) | |
72 | ||
73 | (make-disk-image? #f) | |
ca85d7bc | 74 | (references-graphs #f) |
04086015 LC |
75 | (disk-image-size |
76 | (* 100 (expt 2 20)))) | |
77 | "Evaluate EXP in a QEMU virtual machine running LINUX with INITRD. In the | |
78 | virtual machine, EXP has access to all of INPUTS from the store; it should put | |
79 | its output files in the `/xchg' directory, which is copied to the derivation's | |
80 | output when the VM terminates. | |
81 | ||
82 | When MAKE-DISK-IMAGE? is true, then create a QEMU disk image of | |
ca85d7bc LC |
83 | DISK-IMAGE-SIZE bytes and return it. |
84 | ||
85 | When REFERENCES-GRAPHS is true, it must be a list of file name/store path | |
86 | pairs, as for `derivation'. The files containing the reference graphs are | |
87 | made available under the /xchg CIFS share." | |
8ab73e91 LC |
88 | ;; FIXME: Allow use of macros from other modules, as done in |
89 | ;; `build-expression->derivation'. | |
90 | ||
04086015 LC |
91 | (define input-alist |
92 | (map (match-lambda | |
4c0f0673 | 93 | ((input (? package? package)) |
04086015 | 94 | `(,input . ,(package-output store package "out" system))) |
4c0f0673 LC |
95 | ((input (? package? package) sub-drv) |
96 | `(,input . ,(package-output store package sub-drv system))) | |
37c58656 LC |
97 | ((input (? derivation? drv)) |
98 | `(,input . ,(derivation->output-path drv))) | |
99 | ((input (? derivation? drv) sub-drv) | |
100 | `(,input . ,(derivation->output-path drv sub-drv))) | |
4c0f0673 LC |
101 | ((input (and (? string?) (? store-path?) file)) |
102 | `(,input . ,file))) | |
04086015 LC |
103 | inputs)) |
104 | ||
105 | (define exp* | |
106 | ;; EXP, but with INPUTS available. | |
107 | `(let ((%build-inputs ',input-alist)) | |
108 | ,exp)) | |
109 | ||
110 | (define builder | |
111 | ;; Code that launches the VM that evaluates EXP. | |
ca85d7bc LC |
112 | `(let () |
113 | (use-modules (guix build utils) | |
114 | (srfi srfi-1) | |
115 | (ice-9 rdelim)) | |
04086015 LC |
116 | |
117 | (let ((out (assoc-ref %outputs "out")) | |
118 | (cu (string-append (assoc-ref %build-inputs "coreutils") | |
119 | "/bin")) | |
120 | (qemu (string-append (assoc-ref %build-inputs "qemu") | |
121 | "/bin/qemu-system-" | |
122 | (car (string-split ,system #\-)))) | |
123 | (img (string-append (assoc-ref %build-inputs "qemu") | |
124 | "/bin/qemu-img")) | |
125 | (linux (string-append (assoc-ref %build-inputs "linux") | |
126 | "/bzImage")) | |
127 | (initrd (string-append (assoc-ref %build-inputs "initrd") | |
128 | "/initrd")) | |
129 | (builder (assoc-ref %build-inputs "builder"))) | |
130 | ||
131 | ;; XXX: QEMU uses "rm -rf" when it's done to remove the temporary SMB | |
132 | ;; directory, so it really needs `rm' in $PATH. | |
133 | (setenv "PATH" cu) | |
134 | ||
135 | ,(if make-disk-image? | |
136 | `(zero? (system* img "create" "image.qcow2" | |
137 | ,(number->string disk-image-size))) | |
138 | '(begin)) | |
139 | ||
140 | (mkdir "xchg") | |
ca85d7bc LC |
141 | |
142 | ;; Copy the reference-graph files under xchg/ so EXP can access it. | |
143 | (begin | |
144 | ,@(match references-graphs | |
145 | (((graph-files . _) ...) | |
146 | (map (lambda (file) | |
147 | `(copy-file ,file | |
148 | ,(string-append "xchg/" file))) | |
149 | graph-files)) | |
150 | (#f '()))) | |
151 | ||
04086015 LC |
152 | (and (zero? |
153 | (system* qemu "-nographic" "-no-reboot" | |
154 | "-net" "nic,model=e1000" | |
155 | "-net" (string-append "user,smb=" (getcwd)) | |
156 | "-kernel" linux | |
157 | "-initrd" initrd | |
158 | "-append" (string-append "console=ttyS0 --load=" | |
159 | builder) | |
160 | ,@(if make-disk-image? | |
161 | '("-hda" "image.qcow2") | |
162 | '()))) | |
163 | ,(if make-disk-image? | |
164 | '(copy-file "image.qcow2" ; XXX: who mkdir'd OUT? | |
165 | out) | |
166 | '(begin | |
167 | (mkdir out) | |
168 | (copy-recursively "xchg" out))))))) | |
169 | ||
170 | (let ((user-builder (add-text-to-store store "builder-in-linux-vm" | |
171 | (object->string exp*) | |
172 | '())) | |
173 | (->drv (cut package-derivation store <> system)) | |
174 | (coreutils (car (assoc-ref %final-inputs "coreutils")))) | |
175 | (build-expression->derivation store name system builder | |
176 | `(("qemu" ,(->drv qemu)) | |
177 | ("linux" ,(->drv linux)) | |
178 | ("initrd" ,(->drv initrd)) | |
179 | ("coreutils" ,(->drv coreutils)) | |
180 | ("builder" ,user-builder) | |
181 | ,@(map (match-lambda | |
4c0f0673 LC |
182 | ((name (? package? package) |
183 | sub-drv ...) | |
04086015 | 184 | `(,name ,(->drv package) |
4c0f0673 LC |
185 | ,@sub-drv)) |
186 | ((name (? string? file)) | |
37c58656 LC |
187 | `(,name ,file)) |
188 | (tuple tuple)) | |
04086015 LC |
189 | inputs)) |
190 | #:env-vars env-vars | |
ca85d7bc LC |
191 | #:modules (delete-duplicates |
192 | `((guix build utils) | |
193 | ,@modules)) | |
194 | #:guile-for-build guile-for-build | |
195 | #:references-graphs references-graphs))) | |
04086015 LC |
196 | |
197 | (define* (qemu-image store #:key | |
198 | (name "qemu-image") | |
199 | (system (%current-system)) | |
200 | (disk-image-size (* 100 (expt 2 20))) | |
0e2ddecd | 201 | grub-configuration |
30f25b03 | 202 | (initialize-store? #f) |
785859d3 | 203 | (populate #f) |
93d44bd8 | 204 | (inputs '()) |
002e5ba8 | 205 | (inputs-to-copy '())) |
1b89a66e | 206 | "Return a bootable, stand-alone QEMU image. The returned image is a full |
0e2ddecd LC |
207 | disk image, with a GRUB installation that uses GRUB-CONFIGURATION as its |
208 | configuration file. | |
93d44bd8 LC |
209 | |
210 | INPUTS-TO-COPY is a list of inputs (as for packages) whose closure is copied | |
30f25b03 LC |
211 | into the image being built. When INITIALIZE-STORE? is true, initialize the |
212 | store database in the image so that Guix can be used in the image. | |
785859d3 | 213 | |
d5d0f286 LC |
214 | POPULATE is a list of directives stating directories or symlinks to be created |
215 | in the disk image partition. It is evaluated once the image has been | |
216 | populated with INPUTS-TO-COPY. It can be used to provide additional files, | |
217 | such as /etc files." | |
93d44bd8 LC |
218 | (define input->name+derivation |
219 | (match-lambda | |
220 | ((name (? package? package)) | |
59688fc4 | 221 | `(,name . ,(derivation->output-path |
93d44bd8 LC |
222 | (package-derivation store package system)))) |
223 | ((name (? package? package) sub-drv) | |
59688fc4 | 224 | `(,name . ,(derivation->output-path |
93d44bd8 | 225 | (package-derivation store package system) |
1b89a66e | 226 | sub-drv))) |
37c58656 LC |
227 | ((name (? derivation? drv)) |
228 | `(,name . ,(derivation->output-path drv))) | |
229 | ((name (? derivation? drv) sub-drv) | |
230 | `(,name . ,(derivation->output-path drv sub-drv))) | |
1b89a66e LC |
231 | ((input (and (? string?) (? store-path?) file)) |
232 | `(,input . ,file)))) | |
93d44bd8 | 233 | |
04086015 | 234 | (expression->derivation-in-linux-vm |
2455085a | 235 | store "qemu-image" |
93d44bd8 LC |
236 | `(let () |
237 | (use-modules (ice-9 rdelim) | |
238 | (srfi srfi-1) | |
7c1d8146 LC |
239 | (guix build utils) |
240 | (guix build linux-initrd)) | |
93d44bd8 LC |
241 | |
242 | (let ((parted (string-append (assoc-ref %build-inputs "parted") | |
243 | "/sbin/parted")) | |
244 | (mkfs (string-append (assoc-ref %build-inputs "e2fsprogs") | |
245 | "/sbin/mkfs.ext3")) | |
246 | (grub (string-append (assoc-ref %build-inputs "grub") | |
247 | "/sbin/grub-install")) | |
248 | (umount (string-append (assoc-ref %build-inputs "util-linux") | |
249 | "/bin/umount")) ; XXX: add to Guile | |
0e2ddecd | 250 | (grub.cfg (assoc-ref %build-inputs "grub.cfg"))) |
93d44bd8 LC |
251 | |
252 | (define (read-reference-graph port) | |
253 | ;; Return a list of store paths from the reference graph at PORT. | |
254 | ;; The data at PORT is the format produced by #:references-graphs. | |
255 | (let loop ((line (read-line port)) | |
256 | (result '())) | |
257 | (cond ((eof-object? line) | |
258 | (delete-duplicates result)) | |
259 | ((string-prefix? "/" line) | |
260 | (loop (read-line port) | |
261 | (cons line result))) | |
262 | (else | |
263 | (loop (read-line port) | |
264 | result))))) | |
265 | ||
266 | (define (things-to-copy) | |
267 | ;; Return the list of store files to copy to the image. | |
268 | (define (graph-from-file file) | |
269 | (call-with-input-file file | |
270 | read-reference-graph)) | |
271 | ||
272 | ,(match inputs-to-copy | |
273 | (((graph-files . _) ...) | |
274 | `(let* ((graph-files ',(map (cut string-append "/xchg/" <>) | |
275 | graph-files)) | |
276 | (paths (append-map graph-from-file graph-files))) | |
277 | (delete-duplicates paths))) | |
278 | (#f ''()))) | |
279 | ||
280 | ;; GRUB is full of shell scripts. | |
281 | (setenv "PATH" | |
282 | (string-append (dirname grub) ":" | |
283 | (assoc-ref %build-inputs "coreutils") "/bin:" | |
284 | (assoc-ref %build-inputs "findutils") "/bin:" | |
285 | (assoc-ref %build-inputs "sed") "/bin:" | |
286 | (assoc-ref %build-inputs "grep") "/bin:" | |
287 | (assoc-ref %build-inputs "gawk") "/bin")) | |
288 | ||
289 | (display "creating partition table...\n") | |
93d44bd8 LC |
290 | (and (zero? (system* parted "/dev/vda" "mklabel" "msdos" |
291 | "mkpart" "primary" "ext2" "1MiB" | |
292 | ,(format #f "~aB" | |
293 | (- disk-image-size | |
294 | (* 5 (expt 2 20)))))) | |
295 | (begin | |
296 | (display "creating ext3 partition...\n") | |
93d44bd8 | 297 | (and (zero? (system* mkfs "-F" "/dev/vda1")) |
17886b30 | 298 | (let ((store (string-append "/fs" ,%store-directory))) |
93d44bd8 LC |
299 | (display "mounting partition...\n") |
300 | (mkdir "/fs") | |
301 | (mount "/dev/vda1" "/fs" "ext3") | |
302 | (mkdir-p "/fs/boot/grub") | |
0e2ddecd | 303 | (symlink grub.cfg "/fs/boot/grub/grub.cfg") |
93d44bd8 LC |
304 | |
305 | ;; Populate the image's store. | |
17886b30 LC |
306 | (mkdir-p store) |
307 | (chmod store #o1775) | |
93d44bd8 LC |
308 | (for-each (lambda (thing) |
309 | (copy-recursively thing | |
310 | (string-append "/fs" | |
311 | thing))) | |
0e2ddecd | 312 | (cons grub.cfg (things-to-copy))) |
93d44bd8 | 313 | |
7c1d8146 LC |
314 | ;; Populate /dev. |
315 | (make-essential-device-nodes #:root "/fs") | |
316 | ||
30f25b03 LC |
317 | ;; Optionally, register the inputs in the image's store. |
318 | (let* ((guix (assoc-ref %build-inputs "guix")) | |
319 | (register (string-append guix | |
320 | "/sbin/guix-register"))) | |
321 | ,@(if initialize-store? | |
322 | (match inputs-to-copy | |
323 | (((graph-files . _) ...) | |
324 | (map (lambda (closure) | |
325 | `(system* register "--prefix" "/fs" | |
326 | ,(string-append "/xchg/" | |
327 | closure))) | |
328 | graph-files))) | |
329 | '(#f))) | |
330 | ||
d5d0f286 LC |
331 | ;; Evaluate the POPULATE directives. |
332 | ,@(let loop ((directives populate) | |
333 | (statements '())) | |
334 | (match directives | |
335 | (() | |
336 | (reverse statements)) | |
337 | ((('directory name) rest ...) | |
338 | (loop rest | |
339 | (cons `(mkdir-p ,(string-append "/fs" name)) | |
340 | statements))) | |
17886b30 LC |
341 | ((('directory name uid gid) rest ...) |
342 | (let ((dir (string-append "/fs" name))) | |
343 | (loop rest | |
344 | (cons* `(chown ,dir ,uid ,gid) | |
345 | `(mkdir-p ,dir) | |
346 | statements)))) | |
d5d0f286 LC |
347 | (((new '-> old) rest ...) |
348 | (loop rest | |
349 | (cons `(symlink ,old | |
350 | ,(string-append "/fs" new)) | |
351 | statements))))) | |
352 | ||
785859d3 LC |
353 | (and=> (assoc-ref %build-inputs "populate") |
354 | (lambda (populate) | |
355 | (chdir "/fs") | |
356 | (primitive-load populate) | |
357 | (chdir "/"))) | |
358 | ||
8ab73e91 LC |
359 | (display "clearing file timestamps...\n") |
360 | (for-each (lambda (file) | |
361 | (let ((s (lstat file))) | |
362 | ;; XXX: Guile uses libc's 'utime' function | |
363 | ;; (not 'futime'), so the timestamp of | |
364 | ;; symlinks cannot be changed, and there | |
365 | ;; are symlinks here pointing to | |
366 | ;; /nix/store, which is the host, | |
367 | ;; read-only store. | |
368 | (unless (eq? (stat:type s) 'symlink) | |
369 | (utime file 0 0 0 0)))) | |
370 | (find-files "/fs" ".*")) | |
371 | ||
93d44bd8 LC |
372 | (and (zero? |
373 | (system* grub "--no-floppy" | |
374 | "--boot-directory" "/fs/boot" | |
375 | "/dev/vda")) | |
0e2ddecd | 376 | (zero? (system* umount "/fs")) |
93d44bd8 | 377 | (reboot)))))))) |
2455085a LC |
378 | #:system system |
379 | #:inputs `(("parted" ,parted) | |
380 | ("grub" ,grub) | |
381 | ("e2fsprogs" ,e2fsprogs) | |
0e2ddecd | 382 | ("grub.cfg" ,grub-configuration) |
93d44bd8 | 383 | |
2455085a LC |
384 | ;; For shell scripts. |
385 | ("sed" ,(car (assoc-ref %final-inputs "sed"))) | |
386 | ("grep" ,(car (assoc-ref %final-inputs "grep"))) | |
387 | ("coreutils" ,(car (assoc-ref %final-inputs "coreutils"))) | |
388 | ("findutils" ,(car (assoc-ref %final-inputs "findutils"))) | |
389 | ("gawk" ,(car (assoc-ref %final-inputs "gawk"))) | |
93d44bd8 LC |
390 | ("util-linux" ,util-linux) |
391 | ||
0b86a82d | 392 | ,@(if initialize-store? |
f887601a | 393 | `(("guix" ,guix)) |
0b86a82d | 394 | '()) |
785859d3 | 395 | |
93d44bd8 | 396 | ,@inputs-to-copy) |
04086015 | 397 | #:make-disk-image? #t |
93d44bd8 LC |
398 | #:disk-image-size disk-image-size |
399 | #:references-graphs (map input->name+derivation inputs-to-copy) | |
7c1d8146 LC |
400 | #:modules '((guix build utils) |
401 | (guix build linux-initrd)))) | |
04086015 LC |
402 | |
403 | \f | |
404 | ;;; | |
aedb72fb | 405 | ;;; Stand-alone VM image. |
04086015 LC |
406 | ;;; |
407 | ||
0b86a82d LC |
408 | (define* (union store inputs |
409 | #:key (guile (%guile-for-build)) (system (%current-system)) | |
410 | (name "union")) | |
411 | "Return a derivation that builds the union of INPUTS. INPUTS is a list of | |
412 | input tuples." | |
413 | (define builder | |
414 | `(begin | |
415 | (use-modules (guix build union)) | |
416 | ||
417 | (setvbuf (current-output-port) _IOLBF) | |
418 | (setvbuf (current-error-port) _IOLBF) | |
419 | ||
420 | (let ((output (assoc-ref %outputs "out")) | |
421 | (inputs (map cdr %build-inputs))) | |
422 | (format #t "building union `~a' with ~a packages...~%" | |
423 | output (length inputs)) | |
424 | (union-build output inputs)))) | |
425 | ||
426 | (build-expression->derivation store name system builder | |
427 | (map (match-lambda | |
428 | ((name (? package? p)) | |
429 | `(,name ,(package-derivation store p | |
430 | system))) | |
431 | ((name (? package? p) output) | |
432 | `(,name ,(package-derivation store p | |
433 | system) | |
434 | ,output)) | |
435 | (x x)) | |
436 | inputs) | |
437 | #:modules '((guix build union)) | |
438 | #:guile-for-build guile)) | |
439 | ||
aedb72fb LC |
440 | (define (system-qemu-image store) |
441 | "Return the derivation of a QEMU image of the GNU system." | |
43a27798 LC |
442 | (define motd |
443 | (add-text-to-store store "motd" " | |
444 | Happy birthday, GNU! http://www.gnu.org/gnu30 | |
445 | ||
446 | ")) | |
447 | ||
aedb72fb LC |
448 | (define %pam-services |
449 | ;; Services known to PAM. | |
450 | (list %pam-other-services | |
43a27798 LC |
451 | (unix-pam-service "login" |
452 | #:allow-empty-passwords? #t | |
453 | #:motd motd))) | |
aedb72fb | 454 | |
4646e30a LC |
455 | (define %dmd-services |
456 | ;; Services run by dmd. | |
ba47851f LC |
457 | (list (host-name-service store "gnu") |
458 | (mingetty-service store "tty1") | |
4646e30a LC |
459 | (mingetty-service store "tty2") |
460 | (mingetty-service store "tty3") | |
25eb16bf LC |
461 | (mingetty-service store "tty4") |
462 | (mingetty-service store "tty5") | |
463 | (mingetty-service store "tty6") | |
9fcc3555 | 464 | (syslog-service store) |
f887601a | 465 | (guix-service store) |
349746df | 466 | (nscd-service store) |
f83e943f LC |
467 | |
468 | ;; QEMU networking settings. | |
59c5c4de LC |
469 | (static-networking-service store "eth0" "10.0.2.10" |
470 | #:gateway "10.0.2.2"))) | |
f83e943f | 471 | |
17886b30 LC |
472 | (define build-user-gid 30000) |
473 | ||
d0c66871 | 474 | (define build-accounts |
17886b30 | 475 | (guix-build-accounts store 10 #:gid build-user-gid)) |
d0c66871 | 476 | |
f83e943f LC |
477 | (define resolv.conf |
478 | ;; Name resolution for default QEMU settings. | |
479 | (add-text-to-store store "resolv.conf" | |
480 | "nameserver 10.0.2.3\n")) | |
4646e30a | 481 | |
3abf9b44 LC |
482 | (define etc-services |
483 | (string-append (package-output store net-base) "/etc/services")) | |
484 | (define etc-protocols | |
485 | (string-append (package-output store net-base) "/etc/protocols")) | |
486 | (define etc-rpc | |
487 | (string-append (package-output store net-base) "/etc/rpc")) | |
488 | ||
aedb72fb LC |
489 | (parameterize ((%guile-for-build (package-derivation store guile-final))) |
490 | (let* ((bash-drv (package-derivation store bash)) | |
59688fc4 | 491 | (bash-file (string-append (derivation->output-path bash-drv) |
aedb72fb | 492 | "/bin/bash")) |
4646e30a LC |
493 | (dmd-drv (package-derivation store dmd)) |
494 | (dmd-file (string-append (derivation->output-path dmd-drv) | |
495 | "/bin/dmd")) | |
496 | (dmd-conf (dmd-configuration-file store %dmd-services)) | |
d0c66871 LC |
497 | (accounts (cons* (user-account |
498 | (name "root") | |
499 | (password "") | |
500 | (uid 0) (gid 0) | |
501 | (comment "System administrator") | |
502 | (home-directory "/") | |
503 | (shell bash-file)) | |
504 | (user-account | |
505 | (name "guest") | |
506 | (password "") | |
507 | (uid 1000) (gid 100) | |
508 | (comment "Guest of GNU") | |
509 | (home-directory "/home/guest") | |
510 | (shell bash-file)) | |
511 | build-accounts)) | |
aedb72fb LC |
512 | (passwd (passwd-file store accounts)) |
513 | (shadow (passwd-file store accounts #:shadow? #t)) | |
16a0e9dc LC |
514 | (group (group-file store |
515 | (list (user-group | |
516 | (name "root") | |
8bc755c0 LC |
517 | (id 0)) |
518 | (user-group | |
519 | (name "users") | |
520 | (id 100) | |
d0c66871 LC |
521 | (members '("guest"))) |
522 | (user-group | |
523 | (name "guixbuild") | |
17886b30 | 524 | (id build-user-gid) |
d0c66871 LC |
525 | (members (map user-account-name |
526 | build-accounts)))))) | |
aedb72fb | 527 | (pam.d-drv (pam-services->directory store %pam-services)) |
59688fc4 | 528 | (pam.d (derivation->output-path pam.d-drv)) |
0b86a82d LC |
529 | |
530 | (packages `(("coreutils" ,coreutils) | |
531 | ("bash" ,bash) | |
532 | ("guile" ,guile-2.0) | |
533 | ("dmd" ,dmd) | |
534 | ("gcc" ,gcc-final) | |
535 | ("libc" ,glibc-final) | |
f83e943f | 536 | ("inetutils" ,inetutils) |
9f84f12f LC |
537 | ("findutils" ,findutils) |
538 | ("grep" ,grep) | |
539 | ("sed" ,sed) | |
5b16ff09 LC |
540 | ("procps" ,procps) |
541 | ("psmisc" ,psmisc) | |
542 | ("zile" ,zile) | |
f887601a | 543 | ("guix" ,guix))) |
0b86a82d LC |
544 | |
545 | ;; TODO: Replace with a real profile with a manifest. | |
546 | ;; TODO: Generate bashrc from packages' search-paths. | |
547 | (profile-drv (union store packages | |
548 | #:name "default-profile")) | |
549 | (profile (derivation->output-path profile-drv)) | |
550 | (bashrc (add-text-to-store store "bashrc" | |
551 | (string-append " | |
ba47851f | 552 | export PS1='\\u@\\h\\$ ' |
0b86a82d LC |
553 | export PATH=$HOME/.guix-profile/bin:" profile "/bin:" profile "/sbin |
554 | export CPATH=$HOME/.guix-profile/include:" profile "/include | |
555 | export LIBRARY_PATH=$HOME/.guix-profile/lib:" profile "/lib | |
556 | alias ls='ls -p --color' | |
557 | alias ll='ls -l' | |
558 | "))) | |
559 | ||
43a27798 LC |
560 | (issue (add-text-to-store store "issue" " |
561 | This is an alpha preview of the GNU system. Welcome. | |
562 | ||
563 | This image features the GNU Guix package manager, which was used to | |
564 | build it (http://www.gnu.org/software/guix/). The init system is | |
565 | GNU dmd (http://www.gnu.org/software/dmd/). | |
566 | ||
8bc755c0 | 567 | You can log in as 'guest' or 'root' with no password. |
43a27798 LC |
568 | ")) |
569 | ||
17886b30 LC |
570 | (populate `((directory "/nix/store" 0 ,build-user-gid) |
571 | (directory "/etc") | |
349746df LC |
572 | (directory "/var/log") ; for dmd |
573 | (directory "/var/run/nscd") | |
d5d0f286 LC |
574 | ("/etc/shadow" -> ,shadow) |
575 | ("/etc/passwd" -> ,passwd) | |
8bc755c0 | 576 | ("/etc/group" -> ,group) |
d5d0f286 LC |
577 | ("/etc/login.defs" -> "/dev/null") |
578 | ("/etc/pam.d" -> ,pam.d) | |
f83e943f | 579 | ("/etc/resolv.conf" -> ,resolv.conf) |
43a27798 | 580 | ("/etc/profile" -> ,bashrc) |
27cab84c | 581 | ("/etc/issue" -> ,issue) |
3abf9b44 LC |
582 | ("/etc/services" -> ,etc-services) |
583 | ("/etc/protocols" -> ,etc-protocols) | |
584 | ("/etc/rpc" -> ,etc-rpc) | |
27cab84c | 585 | (directory "/var/nix/gcroots") |
8bc755c0 | 586 | ("/var/nix/gcroots/default-profile" -> ,profile) |
17886b30 LC |
587 | (directory "/tmp") |
588 | (directory "/var/nix/profiles/per-user/root" 0 0) | |
589 | (directory "/var/nix/profiles/per-user/guest" | |
590 | 1000 100) | |
591 | (directory "/home/guest" 1000 100))) | |
59688fc4 | 592 | (out (derivation->output-path |
aedb72fb | 593 | (package-derivation store mingetty))) |
4646e30a LC |
594 | (boot (add-text-to-store store "boot" |
595 | (object->string | |
596 | `(execl ,dmd-file "dmd" | |
867e3c55 | 597 | "--config" ,dmd-conf)))) |
aedb72fb | 598 | (entries (list (menu-entry |
65d195e1 LC |
599 | (label (string-append |
600 | "GNU System with Linux-Libre " | |
601 | (package-version linux-libre) | |
602 | " (technology preview)")) | |
aedb72fb LC |
603 | (linux linux-libre) |
604 | (linux-arguments `("--root=/dev/vda1" | |
605 | ,(string-append "--load=" boot))) | |
606 | (initrd gnu-system-initrd)))) | |
607 | (grub.cfg (grub-configuration-file store entries))) | |
aedb72fb LC |
608 | (qemu-image store |
609 | #:grub-configuration grub.cfg | |
610 | #:populate populate | |
5b16ff09 | 611 | #:disk-image-size (* 550 (expt 2 20)) |
30f25b03 | 612 | #:initialize-store? #t |
aedb72fb LC |
613 | #:inputs-to-copy `(("boot" ,boot) |
614 | ("linux" ,linux-libre) | |
615 | ("initrd" ,gnu-system-initrd) | |
0b86a82d LC |
616 | ("pam.d" ,pam.d-drv) |
617 | ("profile" ,profile-drv) | |
aedb72fb LC |
618 | |
619 | ;; Configuration. | |
4646e30a | 620 | ("dmd.conf" ,dmd-conf) |
43a27798 | 621 | ("etc-pam.d" ,pam.d-drv) |
aedb72fb | 622 | ("etc-passwd" ,passwd) |
4646e30a LC |
623 | ("etc-shadow" ,shadow) |
624 | ("etc-group" ,group) | |
f83e943f | 625 | ("etc-resolv.conf" ,resolv.conf) |
0b86a82d | 626 | ("etc-bashrc" ,bashrc) |
43a27798 LC |
627 | ("etc-issue" ,issue) |
628 | ("etc-motd" ,motd) | |
3abf9b44 | 629 | ("net-base" ,net-base) |
4646e30a LC |
630 | ,@(append-map service-inputs |
631 | %dmd-services)))))) | |
04086015 LC |
632 | |
633 | ;;; vm.scm ends here |