nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

gnu: vm: Setup PAM. 

* gnu/system/vm.scm (example2): Use 'pam-services->directory'.  Change
  POPULATE to create /etc/pam.d, /etc/login.defs, and /var/run.  Change
  BOOT to spawn syslogd; boot to Bash.  Add inputs.
This commit is contained in:
Ludovic Courtès 2013-09-11 01:07:07 +02:00
parent 3b07625ad6
commit a843fe2222
1 changed files with 42 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

61
gnu/system/vm.scm
View File

@ -33,8 +33,7 @@
#:use-module (gnu packages linux-initrd) #:use-module (gnu packages linux-initrd)
#:use-module ((gnu packages make-bootstrap) #:use-module ((gnu packages make-bootstrap)
#:select (%guile-static-stripped)) #:select (%guile-static-stripped))
#:use-module ((gnu packages system) #:use-module (gnu packages system)
#:select (mingetty))
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (ice-9 match) #:use-module (ice-9 match)
@ -396,6 +395,11 @@ is a /etc/passwd file."
(lambda () (lambda ()
(set! store (open-connection))) (set! store (open-connection)))
(lambda () (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))) (parameterize ((%guile-for-build (package-derivation store guile-final)))
(let* ((bash-drv (package-derivation store bash)) (let* ((bash-drv (package-derivation store bash))
(bash-file (string-append (derivation-path->output-path bash-drv) (bash-file (string-append (derivation-path->output-path bash-drv)
@ -404,17 +408,26 @@ is a /etc/passwd file."
"/" bash-file))) "/" bash-file)))
(passwd (passwd-file store accounts)) (passwd (passwd-file store accounts))
(shadow (passwd-file store accounts #:shadow? #t)) (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 (populate
(add-text-to-store store "populate-qemu-image" (add-text-to-store store "populate-qemu-image"
(object->string (object->string
`(begin `(begin
(mkdir-p "etc") (mkdir-p "etc")
(symlink ,shadow "etc/shadow") (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))) (list passwd)))
(out (derivation-path->output-path (out (derivation-path->output-path
(package-derivation store mingetty))) (package-derivation store mingetty)))
(getty (string-append out "/sbin/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" (boot (add-text-to-store store "boot"
(object->string (object->string
`(begin `(begin
@ -423,9 +436,15 @@ is a /etc/passwd file."
;; 'TIOCSCTTY'. ;; 'TIOCSCTTY'.
(setsid) (setsid)
;; Directly into mingetty. (when (zero? (primitive-fork))
(execl ,getty "mingetty" (format #t "starting syslogd as ~a~%"
"--noclear" "tty1"))) (getpid))
(execl ,syslogd "syslogd"))
;; Directly into mingetty. XXX
;; (execl ,getty "mingetty"
;; "--noclear" "tty1")
(execl ,bash-file "bash")))
(list out))) (list out)))
(entries (list (menu-entry (entries (list (menu-entry
(label "Boot-to-Guile! (GNU System technology preview)") (label "Boot-to-Guile! (GNU System technology preview)")
@ -434,20 +453,24 @@ is a /etc/passwd file."
,(string-append "--load=" boot))) ,(string-append "--load=" boot)))
(initrd gnu-system-initrd)))) (initrd gnu-system-initrd))))
(grub.cfg (grub-configuration-file store entries))) (grub.cfg (grub-configuration-file store entries)))
(qemu-image store (build-derivations store (list pam.d-drv))
#:grub-configuration grub.cfg (qemu-image store
#:populate populate #:grub-configuration grub.cfg
#:disk-image-size (* 400 (expt 2 20)) #:populate populate
#:inputs-to-copy `(("boot" ,boot) #:disk-image-size (* 400 (expt 2 20))
("linux" ,linux-libre) #:inputs-to-copy `(("boot" ,boot)
("initrd" ,gnu-system-initrd) ("linux" ,linux-libre)
("coreutils" ,coreutils) ("initrd" ,gnu-system-initrd)
("bash" ,bash) ("coreutils" ,coreutils)
("guile" ,guile-2.0) ("bash" ,bash)
("mingetty" ,mingetty) ("guile" ,guile-2.0)
("mingetty" ,mingetty)
("inetutils" ,inetutils)
("etc-passwd" ,passwd) ;; Configuration.
("etc-shadow" ,shadow)))))) ("etc-pam.d" ,pam.d)
("etc-passwd" ,passwd)
("etc-shadow" ,shadow))))))
(lambda () (lambda ()
(close-connection store))))) (close-connection store)))))