ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 21:38:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

gnu: vm: Setup PAM.

Browse source 
* 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

35
gnu/system/vm.scm
View file

@ -33,8 +33,7 @@ (define-module (gnu system vm)
#: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 @@ (define (example2)
(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 @@ (define (example2)
"/" 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 @@ (define (example2)
;; '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,6 +453,7 @@ (define (example2)
,(string-append "--load=" boot)))
(initrd gnu-system-initrd))))
(grub.cfg (grub-configuration-file store entries)))
(build-derivations store (list pam.d-drv))
(qemu-image store
#:grub-configuration grub.cfg
#:populate populate
@ -445,7 +465,10 @@ (define (example2)
("bash" ,bash)
("guile" ,guile-2.0)
("mingetty" ,mingetty)
("inetutils" ,inetutils)
;; Configuration.
("etc-pam.d" ,pam.d)
("etc-passwd" ,passwd)
("etc-shadow" ,shadow))))))
(lambda ()