summaryrefslogtreecommitdiff
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)))))