From 78ed003811a38a7a3de56316755a2808b7d87e45 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Mon, 9 Dec 2013 22:29:01 +0100 Subject: [PATCH] gnu: Add 'inputs' field to ; make 'shell' a monadic value. * gnu/system/shadow.scm ()[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. --- gnu/system.scm | 11 +++++----- gnu/system/dmd.scm | 8 +++---- gnu/system/shadow.scm | 49 ++++++++++++++++++++++++------------------- gnu/system/vm.scm | 4 +--- 4 files changed, 38 insertions(+), 34 deletions(-) diff --git a/gnu/system.scm b/gnu/system.scm index 79d87855f6..c6b67a7a1c 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -281,8 +281,7 @@ alias ll='ls -l' (password "") (uid 0) (gid 0) (comment "System administrator") - (home-directory "/") - (shell bash-file)) + (home-directory "/")) (append (operating-system-users os) (append-map service-user-accounts services)))) @@ -320,22 +319,22 @@ alias ll='ls -l' (initrd initrd)))) (grub.cfg (grub-configuration-file entries)) (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) ("kernel" ,kernel-dir) ("initrd" ,initrd-file) ("dmd.conf" ,dmd-conf) - ("bash" ,bash-file) ; XXX: should be a input? ("profile" ,profile) ("grub.cfg" ,grub.cfg) ("etc" ,etc) - ("service-inputs" ,(derivation->output-path extras))) + ("system-inputs" ,(derivation->output-path extras))) #:inputs `(("kernel" ,kernel) ("initrd" ,initrd) ("bash" ,bash) ("profile" ,profile-drv) ("etc" ,etc-drv) - ("service-inputs" ,extras)) + ("system-inputs" ,extras)) #:name "system"))) ;;; system.scm ends here diff --git a/gnu/system/dmd.scm b/gnu/system/dmd.scm index 307412a5d5..7cd5f05f78 100644 --- a/gnu/system/dmd.scm +++ b/gnu/system/dmd.scm @@ -181,18 +181,18 @@ (shadow shadow)) "Return a list of COUNT user accounts for Guix build users, with UIDs starting at FIRST-UID, and under GID." - (mlet* %store-monad ((gid* -> gid) - (no-login (package-file shadow "sbin/nologin"))) + (with-monad %store-monad (return (unfold (cut > <> count) (lambda (n) (user-account (name (format #f "guixbuilder~2,'0d" n)) (password "!") (uid (+ first-uid n -1)) - (gid gid*) + (gid gid) (comment (format #f "Guix Build User ~2d" n)) (home-directory "/var/empty") - (shell no-login))) + (shell (package-file shadow "sbin/nologin")) + (inputs `(("shadow" ,shadow))))) 1+ 1)))) diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm index 2cc0b89162..ca24c3df2b 100644 --- a/gnu/system/shadow.scm +++ b/gnu/system/shadow.scm @@ -23,6 +23,7 @@ #:use-module (guix monads) #:use-module ((gnu packages system) #:select (shadow)) + #:use-module (gnu packages bash) #:use-module (srfi srfi-1) #:use-module (ice-9 match) #:export (user-account @@ -34,6 +35,7 @@ user-account-comment user-account-home-directory user-account-shell + user-account-inputs user-group user-group? @@ -61,7 +63,9 @@ (gid user-account-gid) (comment user-account-comment (default "")) (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 make-user-group @@ -93,26 +97,29 @@ 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 beware when SHADOW? is #t! - (define contents - (let loop ((accounts accounts) - (result '())) - (match accounts - ((($ name pass uid gid comment home-dir shell) - rest ...) - (loop rest - (cons (if shadow? - (string-append name - ":" ; XXX: use (crypt PASS …)? - ":::::::") - (string-append name - ":" "x" - ":" (number->string uid) - ":" (number->string gid) - ":" comment ":" home-dir ":" shell)) - result))) - (() - (string-join (reverse result) "\n" 'suffix))))) + (define (contents) + (with-monad %store-monad + (let loop ((accounts accounts) + (result '())) + (match accounts + ((($ name pass uid gid comment home-dir mshell) + rest ...) + (mlet %store-monad ((shell mshell)) + (loop rest + (cons (if shadow? + (string-append name + ":" ; XXX: use (crypt PASS …)? + ":::::::") + (string-append name + ":" "x" + ":" (number->string uid) + ":" (number->string gid) + ":" comment ":" home-dir ":" shell)) + 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 diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 3717e2ac23..8a490fbd6c 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -415,9 +415,7 @@ such as /etc files." (password "") (uid 1000) (gid 100) (comment "Guest of GNU") - (home-directory "/home/guest") - ;; (shell bash-file) - ))) + (home-directory "/home/guest")))) (packages `(("coreutils" ,coreutils) ("bash" ,bash) ("guile" ,guile-2.0)