gnu: vm: Create valid /etc/shadow and /etc/passwd.

* gnu/system/vm.scm (/etc/passwd): Rename to...
  (passwd-file): ... this. Add 'shadow?' keyword parameter.  Change
  format of ACCOUNTS, and fix CONTENTS.
  (example2): Adjust accordingly.  Create both /etc/shadow and
  /etc/passwd, the latter being used by getpwnam(3) & co. when nscd is
  not running.
This commit is contained in:
Ludovic Courtès 2013-09-08 23:52:03 +02:00
parent 8ab73e91d6
commit 98aeb06b41
1 changed files with 18 additions and 11 deletions

View File

@ -363,22 +363,28 @@ It can be used to provide additional files, such as /etc files."
(lambda () (lambda ()
(close-connection store))))) (close-connection store)))))
(define (/etc/shadow store accounts) (define* (passwd-file store accounts #:key shadow?)
"Return a /etc/shadow file for ACCOUNTS." "Return a password file for ACCOUNTS, a list of vectors as returned by
'getpwnam'. If SHADOW? is true, then it is a /etc/shadow file, otherwise it
is a /etc/passwd file."
;; XXX: The resulting file is world-readable, so don't rely on it!
(define contents (define contents
(let loop ((accounts accounts) (let loop ((accounts accounts)
(result '())) (result '()))
(match accounts (match accounts
(((name uid gid comment home-dir shell) rest ...) ((#(name pass uid gid comment home-dir shell) rest ...)
(loop rest (loop rest
(cons (string-append name "::" (number->string uid) (cons (string-append name
":" (if shadow? pass "x")
":" (number->string uid)
":" (number->string gid) ":" (number->string gid)
comment ":" home-dir ":" shell) ":" comment ":" home-dir ":" shell)
result))) result)))
(() (()
(string-concatenate-reverse result))))) (string-concatenate-reverse result)))))
(add-text-to-store store "shadow" contents '())) (add-text-to-store store (if shadow? "shadow" "passwd")
contents '()))
(define (example2) (define (example2)
(let ((store #f)) (let ((store #f))
@ -390,16 +396,17 @@ It can be used to provide additional files, such as /etc files."
(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)
"/bin/bash")) "/bin/bash"))
(passwd (/etc/shadow store (accounts (list (vector "root" "" 0 0 "System administrator"
`(("root" 0 0 "System administrator" "/" "/" bash-file)))
,bash-file)))) (passwd (passwd-file store accounts))
(shadow (passwd-file store accounts #:shadow? #t))
(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 ,(substring passwd 1) (symlink ,shadow "etc/shadow")
"etc/shadow"))) (symlink ,passwd "etc/passwd")))
(list passwd))) (list passwd)))
(out (derivation-path->output-path (out (derivation-path->output-path
(package-derivation store mingetty))) (package-derivation store mingetty)))