aboutsummaryrefslogtreecommitdiff
path: root/gnu/system
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-09-05 23:57:40 +0200
committerLudovic Courtès <ludo@gnu.org>2013-09-05 23:57:40 +0200
commit785859d306eaffcb3488f2d23e4d6c9e4f5db3a5 (patch)
treea3b0300dfaf5630431dac437f75b65b593abd290 /gnu/system
parent002e5ba887837fd353c38eca64596859570ad820 (diff)
downloadguix-785859d306eaffcb3488f2d23e4d6c9e4f5db3a5.tar
guix-785859d306eaffcb3488f2d23e4d6c9e4f5db3a5.tar.gz
gnu: vm: Add /etc/shadow in the QEMU image.
* gnu/system/vm.scm (qemu-image): Add 'populate' keyword parameter and honor it; make it an input. (/etc/shadow): New procedure. (example2): Call it; build 'populate' script, and pass it to 'qemu-image'.
Diffstat (limited to 'gnu/system')
-rw-r--r--gnu/system/vm.scm56
1 files changed, 53 insertions, 3 deletions
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 952cbe45ba..28ab4663b3 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -183,6 +183,7 @@ made available under the /xchg CIFS share."
(linux linux-libre)
(linux-arguments '())
(initrd qemu-initrd)
+ (populate #f)
(inputs '())
(inputs-to-copy '()))
"Return a bootable, stand-alone QEMU image. The returned image is a full
@@ -190,7 +191,11 @@ disk image, with a GRUB installation whose default entry boots LINUX, with the
arguments LINUX-ARGUMENTS, and using INITRD as its initial RAM disk.
INPUTS-TO-COPY is a list of inputs (as for packages) whose closure is copied
-into the image being built."
+into the image being built.
+
+When POPULATE is true, it must be the store file name of a Guile script to run
+in the disk image partition once it has been populated with INPUTS-TO-COPY.
+It can be used to provide additional files, such as /etc files."
(define input->name+derivation
(match-lambda
((name (? package? package))
@@ -289,6 +294,13 @@ into the image being built."
;; Populate /dev.
(make-essential-device-nodes #:root "/fs")
+ (and=> (assoc-ref %build-inputs "populate")
+ (lambda (populate)
+ (chdir "/fs")
+ (primitive-load populate)
+ (chdir "/")))
+
+ ;; TODO: Move to a GRUB menu builder.
(call-with-output-file "/fs/boot/grub/grub.cfg"
(lambda (p)
(format p "
@@ -323,6 +335,10 @@ menuentry \"Boot-to-Guile! (GNU System technology preview)\" {
("gawk" ,(car (assoc-ref %final-inputs "gawk")))
("util-linux" ,util-linux)
+ ,@(if populate
+ `(("populate" ,populate))
+ '())
+
,@inputs-to-copy)
#:make-disk-image? #t
#:disk-image-size disk-image-size
@@ -352,6 +368,23 @@ menuentry \"Boot-to-Guile! (GNU System technology preview)\" {
(lambda ()
(close-connection store)))))
+(define (/etc/shadow store accounts)
+ "Return a /etc/shadow file for ACCOUNTS."
+ (define contents
+ (let loop ((accounts accounts)
+ (result '()))
+ (match accounts
+ (((name uid gid comment home-dir shell) rest ...)
+ (loop rest
+ (cons (string-append name "::" (number->string uid)
+ ":" (number->string gid)
+ comment ":" home-dir ":" shell)
+ result)))
+ (()
+ (string-concatenate-reverse result)))))
+
+ (add-text-to-store store "shadow" contents '()))
+
(define (example2)
(let ((store #f))
(dynamic-wind
@@ -359,7 +392,21 @@ menuentry \"Boot-to-Guile! (GNU System technology preview)\" {
(set! store (open-connection)))
(lambda ()
(parameterize ((%guile-for-build (package-derivation store guile-final)))
- (let* ((out (derivation-path->output-path
+ (let* ((bash-drv (package-derivation store bash))
+ (bash-file (string-append (derivation-path->output-path bash-drv)
+ "/bin/bash"))
+ (passwd (/etc/shadow store
+ `(("root" 0 0 "System administrator" "/"
+ ,bash-file))))
+ (populate
+ (add-text-to-store store "populate-qemu-image"
+ (object->string
+ `(begin
+ (mkdir-p "etc")
+ (symlink ,(substring passwd 1)
+ "etc/shadow")))
+ (list passwd)))
+ (out (derivation-path->output-path
(package-derivation store mingetty)))
(getty (string-append out "/sbin/mingetty"))
(boot (add-text-to-store store "boot"
@@ -375,6 +422,7 @@ menuentry \"Boot-to-Guile! (GNU System technology preview)\" {
"--noclear" "tty1")))
(list out))))
(qemu-image store
+ #:populate populate
#:initrd gnu-system-initrd
#:linux-arguments `("--root=/dev/vda1"
,(string-append "--load=" boot))
@@ -383,7 +431,9 @@ menuentry \"Boot-to-Guile! (GNU System technology preview)\" {
("coreutils" ,coreutils)
("bash" ,bash)
("guile" ,guile-2.0)
- ("mingetty" ,mingetty))))))
+ ("mingetty" ,mingetty)
+
+ ("shadow" ,passwd))))))
(lambda ()
(close-connection store)))))