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

gnu: Add 'inputs' field to <user-account>; make 'shell' a monadic value.

Browse source 
* gnu/system/shadow.scm (<user-account>)[inputs]: New field.
  (passwd-file): Bind the 'shell' field of each account.
* gnu/system/vm.scm (%demo-operating-system): Remove 'shell' field.
* gnu/system/dmd.scm (guix-build-accounts): Store a monadic value in
  'shell'.  Add 'inputs' field.
* gnu/system.scm (operating-system-derivation): Remove 'shell' field for
  'root' account.  Add all the 'user-account-inputs' to EXTRAS.
This commit is contained in:
Ludovic Courtès 2013-12-09 22:29:01 +01:00
parent 13ce0e3aa7
commit 78ed003811
4 changed files with 38 additions and 34 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

11
gnu/system.scm
View file

@ -281,8 +281,7 @@ (define (operating-system-derivation os)
(password "") (password "")
(uid 0) (gid 0) (uid 0) (gid 0)
(comment "System administrator") (comment "System administrator")
(home-directory "/") (home-directory "/"))
(shell bash-file))
(append (operating-system-users os) (append (operating-system-users os)
(append-map service-user-accounts (append-map service-user-accounts
services)))) services))))
@ -320,22 +319,22 @@ (define (operating-system-derivation os)
(initrd initrd)))) (initrd initrd))))
(grub.cfg (grub-configuration-file entries)) (grub.cfg (grub-configuration-file entries))
(extras (links (delete-duplicates (extras (links (delete-duplicates
(append-map service-inputs services))))) (append (append-map service-inputs services)
(append-map user-account-inputs accounts))))))
(file-union `(("boot" ,boot) (file-union `(("boot" ,boot)
("kernel" ,kernel-dir) ("kernel" ,kernel-dir)
("initrd" ,initrd-file) ("initrd" ,initrd-file)
("dmd.conf" ,dmd-conf) ("dmd.conf" ,dmd-conf)
("bash" ,bash-file) ; XXX: should be a <user-account> input?
("profile" ,profile) ("profile" ,profile)
("grub.cfg" ,grub.cfg) ("grub.cfg" ,grub.cfg)
("etc" ,etc) ("etc" ,etc)
("service-inputs" ,(derivation->output-path extras))) ("system-inputs" ,(derivation->output-path extras)))
#:inputs `(("kernel" ,kernel) #:inputs `(("kernel" ,kernel)
("initrd" ,initrd) ("initrd" ,initrd)
("bash" ,bash) ("bash" ,bash)
("profile" ,profile-drv) ("profile" ,profile-drv)
("etc" ,etc-drv) ("etc" ,etc-drv)
("service-inputs" ,extras)) ("system-inputs" ,extras))
#:name "system"))) #:name "system")))
;;; system.scm ends here ;;; system.scm ends here

8
gnu/system/dmd.scm
View file

@ -181,18 +181,18 @@ (define* (guix-build-accounts count #:key
(shadow shadow)) (shadow shadow))
"Return a list of COUNT user accounts for Guix build users, with UIDs "Return a list of COUNT user accounts for Guix build users, with UIDs
starting at FIRST-UID, and under GID." starting at FIRST-UID, and under GID."
(mlet* %store-monad ((gid* -> gid) (with-monad %store-monad
(no-login (package-file shadow "sbin/nologin")))
(return (unfold (cut > <> count) (return (unfold (cut > <> count)
(lambda (n) (lambda (n)
(user-account (user-account
(name (format #f "guixbuilder~2,'0d" n)) (name (format #f "guixbuilder~2,'0d" n))
(password "!") (password "!")
(uid (+ first-uid n -1)) (uid (+ first-uid n -1))
(gid gid*) (gid gid)
(comment (format #f "Guix Build User ~2d" n)) (comment (format #f "Guix Build User ~2d" n))
(home-directory "/var/empty") (home-directory "/var/empty")
(shell no-login))) (shell (package-file shadow "sbin/nologin"))
(inputs `(("shadow" ,shadow)))))
1+ 1+
1)))) 1))))

49
gnu/system/shadow.scm
View file

@ -23,6 +23,7 @@ (define-module (gnu system shadow)
#:use-module (guix monads) #:use-module (guix monads)
#:use-module ((gnu packages system) #:use-module ((gnu packages system)
#:select (shadow)) #:select (shadow))
#:use-module (gnu packages bash)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:export (user-account #:export (user-account
@ -34,6 +35,7 @@ (define-module (gnu system shadow)
user-account-comment user-account-comment
user-account-home-directory user-account-home-directory
user-account-shell user-account-shell
user-account-inputs
user-group user-group
user-group? user-group?
@ -61,7 +63,9 @@ (define-record-type* <user-account>
(gid user-account-gid) (gid user-account-gid)
(comment user-account-comment (default "")) (comment user-account-comment (default ""))
(home-directory user-account-home-directory) (home-directory user-account-home-directory)
(shell user-account-shell (default "/bin/sh"))) (shell user-account-shell ; monadic value
(default (package-file bash "bin/bash")))
(inputs user-account-inputs (default `(("bash" ,bash)))))
(define-record-type* <user-group> (define-record-type* <user-group>
user-group make-user-group user-group make-user-group
@ -93,26 +97,29 @@ (define* (passwd-file accounts #:key shadow?)
SHADOW? is true, then it is a /etc/shadow file, otherwise it is a /etc/passwd SHADOW? is true, then it is a /etc/shadow file, otherwise it is a /etc/passwd
file." file."
;; XXX: The resulting file is world-readable, so beware when SHADOW? is #t! ;; XXX: The resulting file is world-readable, so beware when SHADOW? is #t!
(define contents (define (contents)
(let loop ((accounts accounts) (with-monad %store-monad
(result '())) (let loop ((accounts accounts)
(match accounts (result '()))
((($ <user-account> name pass uid gid comment home-dir shell) (match accounts
rest ...) ((($ <user-account> name pass uid gid comment home-dir mshell)
(loop rest rest ...)
(cons (if shadow? (mlet %store-monad ((shell mshell))
(string-append name (loop rest
":" ; XXX: use (crypt PASS …)? (cons (if shadow?
":::::::") (string-append name
(string-append name ":" ; XXX: use (crypt PASS …)?
":" "x" ":::::::")
":" (number->string uid) (string-append name
":" (number->string gid) ":" "x"
":" comment ":" home-dir ":" shell)) ":" (number->string uid)
result))) ":" (number->string gid)
(() ":" comment ":" home-dir ":" shell))
(string-join (reverse result) "\n" 'suffix))))) result))))
(()
(return (string-join (reverse result) "\n" 'suffix)))))))
(text-file (if shadow? "shadow" "passwd") contents)) (mlet %store-monad ((contents (contents)))
(text-file (if shadow? "shadow" "passwd") contents)))
;;; shadow.scm ends here ;;; shadow.scm ends here

4
gnu/system/vm.scm
View file

@ -415,9 +415,7 @@ (define %demo-operating-system
(password "") (password "")
(uid 1000) (gid 100) (uid 1000) (gid 100)
(comment "Guest of GNU") (comment "Guest of GNU")
(home-directory "/home/guest") (home-directory "/home/guest"))))
;; (shell bash-file)
)))
(packages `(("coreutils" ,coreutils) (packages `(("coreutils" ,coreutils)
("bash" ,bash) ("bash" ,bash)
("guile" ,guile-2.0) ("guile" ,guile-2.0)