summary refs log tree commit diff
diff options
context:
space:
mode:
-rw-r--r--gnu/system/vm.scm63
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)))))