diff options
Diffstat (limited to 'gnu/system/vm.scm')
| -rw-r--r-- | gnu/system/vm.scm | 63 |
1 files changed, 43 insertions, 20 deletions
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 7ad87254d8..28d22efdc3 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -33,8 +33,7 @@ #:use-module (gnu packages linux-initrd) #:use-module ((gnu packages make-bootstrap) #:select (%guile-static-stripped)) - #:use-module ((gnu packages system) - #:select (mingetty)) + #:use-module (gnu packages system) #:use-module (srfi srfi-1) #:use-module (srfi srfi-26) #:use-module (ice-9 match) @@ -396,6 +395,11 @@ is a /etc/passwd file." (lambda () (set! store (open-connection))) (lambda () + (define %pam-services + ;; Services known to PAM. + (list %pam-other-services + (unix-pam-service "login" #:allow-empty-passwords? #t))) + (parameterize ((%guile-for-build (package-derivation store guile-final))) (let* ((bash-drv (package-derivation store bash)) (bash-file (string-append (derivation-path->output-path bash-drv) @@ -404,17 +408,26 @@ is a /etc/passwd file." "/" bash-file))) (passwd (passwd-file store accounts)) (shadow (passwd-file store accounts #:shadow? #t)) + (pam.d-drv (pam-services->directory store %pam-services)) + (pam.d (derivation-path->output-path pam.d-drv)) (populate (add-text-to-store store "populate-qemu-image" (object->string `(begin (mkdir-p "etc") (symlink ,shadow "etc/shadow") - (symlink ,passwd "etc/passwd"))) + (symlink ,passwd "etc/passwd") + (symlink "/dev/null" + "etc/login.defs") + (symlink ,pam.d "etc/pam.d") + (mkdir-p "var/run"))) (list passwd))) (out (derivation-path->output-path (package-derivation store mingetty))) (getty (string-append out "/sbin/mingetty")) + (iu-drv (package-derivation store inetutils)) + (syslogd (string-append (derivation-path->output-path iu-drv) + "/libexec/syslogd")) (boot (add-text-to-store store "boot" (object->string `(begin @@ -423,9 +436,15 @@ is a /etc/passwd file." ;; 'TIOCSCTTY'. (setsid) - ;; Directly into mingetty. - (execl ,getty "mingetty" - "--noclear" "tty1"))) + (when (zero? (primitive-fork)) + (format #t "starting syslogd as ~a~%" + (getpid)) + (execl ,syslogd "syslogd")) + + ;; Directly into mingetty. XXX + ;; (execl ,getty "mingetty" + ;; "--noclear" "tty1") + (execl ,bash-file "bash"))) (list out))) (entries (list (menu-entry (label "Boot-to-Guile! (GNU System technology preview)") @@ -434,20 +453,24 @@ is a /etc/passwd file." ,(string-append "--load=" boot))) (initrd gnu-system-initrd)))) (grub.cfg (grub-configuration-file store entries))) - (qemu-image store - #:grub-configuration grub.cfg - #:populate populate - #:disk-image-size (* 400 (expt 2 20)) - #:inputs-to-copy `(("boot" ,boot) - ("linux" ,linux-libre) - ("initrd" ,gnu-system-initrd) - ("coreutils" ,coreutils) - ("bash" ,bash) - ("guile" ,guile-2.0) - ("mingetty" ,mingetty) - - ("etc-passwd" ,passwd) - ("etc-shadow" ,shadow)))))) + (build-derivations store (list pam.d-drv)) + (qemu-image store + #:grub-configuration grub.cfg + #:populate populate + #:disk-image-size (* 400 (expt 2 20)) + #:inputs-to-copy `(("boot" ,boot) + ("linux" ,linux-libre) + ("initrd" ,gnu-system-initrd) + ("coreutils" ,coreutils) + ("bash" ,bash) + ("guile" ,guile-2.0) + ("mingetty" ,mingetty) + ("inetutils" ,inetutils) + + ;; Configuration. + ("etc-pam.d" ,pam.d) + ("etc-passwd" ,passwd) + ("etc-shadow" ,shadow)))))) (lambda () (close-connection store))))) |