aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--doc/guix.texi31
-rw-r--r--gnu/services.scm7
-rw-r--r--gnu/services/base.scm60
-rw-r--r--gnu/services/dmd.scm77
-rw-r--r--gnu/services/networking.scm58
-rw-r--r--gnu/services/xorg.scm19
-rw-r--r--gnu/system.scm44
-rw-r--r--gnu/system/linux.scm74
-rw-r--r--gnu/system/shadow.scm48
9 files changed, 187 insertions, 231 deletions
diff --git a/doc/guix.texi b/doc/guix.texi
index 9fb226c651..bbfdce51fa 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -3224,29 +3224,26 @@ like:
@lisp
(define (nscd-service)
- (mlet %store-monad ((nscd (package-file glibc "sbin/nscd")))
+ (with-monad %store-monad
(return (service
(documentation "Run libc's name service cache daemon.")
(provision '(nscd))
- (start `(make-forkexec-constructor ,nscd "-f" "/dev/null"
- "--foreground"))
- (stop `(make-kill-destructor))
-
- (respawn? #f)
- (inputs `(("glibc" ,glibc)))))))
+ (start #~(make-forkexec-constructor
+ (string-append #$glibc "/sbin/nscd")
+ "-f" "/dev/null" "--foreground"))
+ (stop #~(make-kill-destructor))
+ (respawn? #f)))))
@end lisp
@noindent
-The @code{inputs} field specifies that this service depends on the
-@var{glibc} package---the package that contains the @command{nscd}
-program. The @code{start} and @code{stop} fields are expressions that
-make use of dmd's facilities to start and stop processes (@pxref{Service
-De- and Constructors,,, dmd, GNU dmd Manual}). The @code{provision}
-field specifies the name under which this service is known to dmd, and
-@code{documentation} specifies on-line documentation. Thus, the
-commands @command{deco start ncsd}, @command{deco stop nscd}, and
-@command{deco doc nscd} will do what you would expect (@pxref{Invoking
-deco,,, dmd, GNU dmd Manual}).
+The @code{start} and @code{stop} fields are G-expressions
+(@pxref{G-Expressions}). They refer to dmd's facilities to start and
+stop processes (@pxref{Service De- and Constructors,,, dmd, GNU dmd
+Manual}). The @code{provision} field specifies the name under which
+this service is known to dmd, and @code{documentation} specifies on-line
+documentation. Thus, the commands @command{deco start ncsd},
+@command{deco stop nscd}, and @command{deco doc nscd} will do what you
+would expect (@pxref{Invoking deco,,, dmd, GNU dmd Manual}).
@c *********************************************************************
diff --git a/gnu/services.scm b/gnu/services.scm
index eccde4e9a3..8b89b11b8f 100644
--- a/gnu/services.scm
+++ b/gnu/services.scm
@@ -26,7 +26,6 @@
service-respawn?
service-start
service-stop
- service-inputs
service-user-accounts
service-user-groups
service-pam-services))
@@ -47,11 +46,9 @@
(default '()))
(respawn? service-respawn? ; Boolean
(default #t))
- (start service-start) ; expression
- (stop service-stop ; expression
+ (start service-start) ; g-expression
+ (stop service-stop ; g-expression
(default #f))
- (inputs service-inputs ; list of inputs
- (default '()))
(user-accounts service-user-accounts ; list of <user-account>
(default '()))
(user-groups service-user-groups ; list of <user-groups>
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 3145a657f8..9561995243 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -24,6 +24,7 @@
#:use-module ((gnu packages base)
#:select (glibc-final))
#:use-module (gnu packages package-management)
+ #:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
@@ -48,8 +49,8 @@
(return (service
(documentation "Initialize the machine's host name.")
(provision '(host-name))
- (start `(lambda _
- (sethostname ,name)))
+ (start #~(lambda _
+ (sethostname #$name)))
(respawn? #f)))))
(define* (mingetty-service tty
@@ -57,8 +58,7 @@
(motd (text-file "motd" "Welcome.\n"))
(allow-empty-passwords? #t))
"Return a service to run mingetty on TTY."
- (mlet %store-monad ((mingetty-bin (package-file mingetty "sbin/mingetty"))
- (motd motd))
+ (mlet %store-monad ((motd motd))
(return
(service
(documentation (string-append "Run mingetty on " tty "."))
@@ -68,10 +68,10 @@
;; service to be done.
(requirement '(host-name))
- (start `(make-forkexec-constructor ,mingetty-bin "--noclear" ,tty))
- (stop `(make-kill-destructor))
- (inputs `(("mingetty" ,mingetty)
- ("motd" ,motd)))
+ (start #~(make-forkexec-constructor
+ (string-append #$mingetty "/sbin/mingetty")
+ "--noclear" #$tty))
+ (stop #~(make-kill-destructor))
(pam-services
;; Let 'login' be known to PAM. All the mingetty services will have
@@ -83,16 +83,17 @@
(define* (nscd-service #:key (glibc glibc-final))
"Return a service that runs libc's name service cache daemon (nscd)."
- (mlet %store-monad ((nscd (package-file glibc "sbin/nscd")))
+ (with-monad %store-monad
(return (service
(documentation "Run libc's name service cache daemon (nscd).")
(provision '(nscd))
- (start `(make-forkexec-constructor ,nscd "-f" "/dev/null"
- "--foreground"))
- (stop `(make-kill-destructor))
+ (start
+ #~(make-forkexec-constructor (string-append #$glibc "/sbin/nscd")
+ "-f" "/dev/null"
+ "--foreground"))
+ (stop #~(make-kill-destructor))
- (respawn? #f)
- (inputs `(("glibc" ,glibc)))))))
+ (respawn? #f)))))
(define (syslog-service)
"Return a service that runs 'syslogd' with reasonable default settings."
@@ -120,17 +121,17 @@
")
(mlet %store-monad
- ((syslog.conf (text-file "syslog.conf" contents))
- (syslogd (package-file inetutils "libexec/syslogd")))
+ ((syslog.conf (text-file "syslog.conf" contents)))
(return
(service
(documentation "Run the syslog daemon (syslogd).")
(provision '(syslogd))
- (start `(make-forkexec-constructor ,syslogd "--no-detach"
- "--rcfile" ,syslog.conf))
- (stop `(make-kill-destructor))
- (inputs `(("inetutils" ,inetutils)
- ("syslog.conf" ,syslog.conf)))))))
+ (start
+ #~(make-forkexec-constructor (string-append #$inetutils
+ "/libexec/syslogd")
+ "--no-detach"
+ "--rcfile" #$syslog.conf))
+ (stop #~(make-kill-destructor))))))
(define* (guix-build-accounts count #:key
(first-uid 30001)
@@ -148,8 +149,7 @@ starting at FIRST-UID, and under GID."
(gid gid)
(comment (format #f "Guix Build User ~2d" n))
(home-directory "/var/empty")
- (shell (package-file shadow "sbin/nologin"))
- (inputs `(("shadow" ,shadow)))))
+ (shell #~(string-append #$shadow "/sbin/nologin"))))
1+
1))))
@@ -157,16 +157,16 @@ starting at FIRST-UID, and under GID."
(build-user-gid 30000) (build-accounts 10))
"Return a service that runs the build daemon from GUIX, and has
BUILD-ACCOUNTS user accounts available under BUILD-USER-GID."
- (mlet %store-monad ((daemon (package-file guix "bin/guix-daemon"))
- (accounts (guix-build-accounts build-accounts
+ (mlet %store-monad ((accounts (guix-build-accounts build-accounts
#:gid build-user-gid)))
(return (service
(provision '(guix-daemon))
- (start `(make-forkexec-constructor ,daemon
- "--build-users-group"
- ,builder-group))
- (stop `(make-kill-destructor))
- (inputs `(("guix" ,guix)))
+ (start
+ #~(make-forkexec-constructor (string-append #$guix
+ "/bin/guix-daemon")
+ "--build-users-group"
+ #$builder-group))
+ (stop #~(make-kill-destructor))
(user-accounts accounts)
(user-groups (list (user-group
(name builder-group)
diff --git a/gnu/services/dmd.scm b/gnu/services/dmd.scm
index 54fb5cbfd6..c187c09857 100644
--- a/gnu/services/dmd.scm
+++ b/gnu/services/dmd.scm
@@ -17,6 +17,7 @@
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu services dmd)
+ #:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (gnu services)
#:use-module (ice-9 match)
@@ -31,50 +32,50 @@
(define (dmd-configuration-file services etc)
"Return the dmd configuration file for SERVICES, that initializes /etc from
-ETC (the name of a directory in the store) on startup."
+ETC (the derivation that builds the /etc directory) on startup."
(define config
- `(begin
- (use-modules (ice-9 ftw))
+ #~(begin
+ (use-modules (ice-9 ftw))
- (register-services
- ,@(map (lambda (service)
- `(make <service>
- #:docstring ',(service-documentation service)
- #:provides ',(service-provision service)
- #:requires ',(service-requirement service)
- #:respawn? ',(service-respawn? service)
- #:start ,(service-start service)
- #:stop ,(service-stop service)))
- services))
+ (register-services
+ #$@(map (lambda (service)
+ #~(make <service>
+ #:docstring '#$(service-documentation service)
+ #:provides '#$(service-provision service)
+ #:requires '#$(service-requirement service)
+ #:respawn? '#$(service-respawn? service)
+ #:start #$(service-start service)
+ #:stop #$(service-stop service)))
+ services))
- ;; /etc is a mixture of static and dynamic settings. Here is where we
- ;; initialize it from the static part.
- (format #t "populating /etc from ~a...~%" ,etc)
- (let ((rm-f (lambda (f)
- (false-if-exception (delete-file f)))))
- (rm-f "/etc/static")
- (symlink ,etc "/etc/static")
- (for-each (lambda (file)
- ;; TODO: Handle 'shadow' specially so that changed
- ;; password aren't lost.
- (let ((target (string-append "/etc/" file))
- (source (string-append "/etc/static/" file)))
- (rm-f target)
- (symlink source target)))
- (scandir ,etc
- (lambda (file)
- (not (member file '("." ".."))))))
+ ;; /etc is a mixture of static and dynamic settings. Here is where we
+ ;; initialize it from the static part.
+ (format #t "populating /etc from ~a...~%" #$etc)
+ (let ((rm-f (lambda (f)
+ (false-if-exception (delete-file f)))))
+ (rm-f "/etc/static")
+ (symlink #$etc "/etc/static")
+ (for-each (lambda (file)
+ ;; TODO: Handle 'shadow' specially so that changed
+ ;; password aren't lost.
+ (let ((target (string-append "/etc/" file))
+ (source (string-append "/etc/static/" file)))
+ (rm-f target)
+ (symlink source target)))
+ (scandir #$etc
+ (lambda (file)
+ (not (member file '("." ".."))))))
- ;; Prevent ETC from being GC'd.
- (rm-f "/var/guix/gcroots/etc-directory")
- (symlink ,etc "/var/guix/gcroots/etc-directory"))
+ ;; Prevent ETC from being GC'd.
+ (rm-f "/var/guix/gcroots/etc-directory")
+ (symlink #$etc "/var/guix/gcroots/etc-directory"))
- ;; guix-daemon 0.6 aborts if 'PATH' is undefined, so work around it.
- (setenv "PATH" "/run/current-system/bin")
+ ;; guix-daemon 0.6 aborts if 'PATH' is undefined, so work around it.
+ (setenv "PATH" "/run/current-system/bin")
- (format #t "starting services...~%")
- (for-each start ',(append-map service-provision services))))
+ (format #t "starting services...~%")
+ (for-each start '#$(append-map service-provision services))))
- (text-file "dmd.conf" (object->string config)))
+ (gexp->file "dmd.conf" config))
;;; dmd.scm ends here
diff --git a/gnu/services/networking.scm b/gnu/services/networking.scm
index 317800db50..5522541735 100644
--- a/gnu/services/networking.scm
+++ b/gnu/services/networking.scm
@@ -20,6 +20,7 @@
#:use-module (gnu services)
#:use-module (gnu packages admin)
#:use-module (gnu packages linux)
+ #:use-module (guix gexp)
#:use-module (guix monads)
#:export (static-networking-service))
@@ -41,40 +42,41 @@ true, it must be a string specifying the default network gateway."
;; TODO: Eventually we should do this using Guile's networking procedures,
;; like 'configure-qemu-networking' does, but the patch that does this is
;; not yet in stock Guile.
- (mlet %store-monad ((ifconfig (package-file inetutils "bin/ifconfig"))
- (route (package-file net-tools "sbin/route")))
+ (with-monad %store-monad
(return
(service
(documentation
(string-append "Set up networking on the '" interface
"' interface using a static IP address."))
(provision '(networking))
- (start `(lambda _
- ;; Return #t if successfully started.
- (and (zero? (system* ,ifconfig ,interface ,ip "up"))
- ,(if gateway
- `(zero? (system* ,route "add" "-net" "default"
- "gw" ,gateway))
- #t)
- ,(if (pair? name-servers)
- `(call-with-output-file "/etc/resolv.conf"
- (lambda (port)
- (display
- "# Generated by 'static-networking-service'.\n"
- port)
- (for-each (lambda (server)
- (format port "nameserver ~a~%"
- server))
- ',name-servers)))
- #t))))
- (stop `(lambda _
+ (start #~(lambda _
+ ;; Return #t if successfully started.
+ (and (zero? (system* (string-append #$inetutils
+ "/bin/ifconfig")
+ #$interface #$ip "up"))
+ #$(if gateway
+ #~(zero? (system* (string-append #$net-tools
+ "/sbin/route")
+ "add" "-net" "default"
+ "gw" #$gateway))
+ #t)
+ #$(if (pair? name-servers)
+ #~(call-with-output-file "/etc/resolv.conf"
+ (lambda (port)
+ (display
+ "# Generated by 'static-networking-service'.\n"
+ port)
+ (for-each (lambda (server)
+ (format port "nameserver ~a~%"
+ server))
+ '#$name-servers)))
+ #t))))
+ (stop #~(lambda _
;; Return #f is successfully stopped.
- (not (and (system* ,ifconfig ,interface "down")
- (system* ,route "del" "-net" "default")))))
- (respawn? #f)
- (inputs `(("inetutils" ,inetutils)
- ,@(if gateway
- `(("net-tools" ,net-tools))
- '())))))))
+ (not (and (system* (string-append #$inetutils "/sbin/ifconfig")
+ #$interface "down")
+ (system* (string-append #$net-tools "/sbin/route")
+ "del" "-net" "default")))))
+ (respawn? #f)))))
;;; networking.scm ends here
diff --git a/gnu/services/xorg.scm b/gnu/services/xorg.scm
index 086150a658..81b5bc17a5 100644
--- a/gnu/services/xorg.scm
+++ b/gnu/services/xorg.scm
@@ -27,6 +27,7 @@
#:use-module (gnu packages gnustep)
#:use-module (gnu packages admin)
#:use-module (gnu packages bash)
+ #:use-module (guix gexp)
#:use-module (guix monads)
#:use-module (guix derivations)
#:export (xorg-start-command
@@ -190,9 +191,7 @@ reboot_cmd " dmd "/sbin/reboot
(string-append "auto_login yes\ndefault_user " default-user)
""))))
- (mlet %store-monad ((slim-bin (package-file slim "bin/slim"))
- (bash-bin (package-file bash "bin/bash"))
- (slim.cfg (slim.cfg)))
+ (mlet %store-monad ((slim.cfg (slim.cfg)))
(return
(service
(documentation "Xorg display server")
@@ -200,15 +199,11 @@ reboot_cmd " dmd "/sbin/reboot
(requirement '(host-name))
(start
;; XXX: Work around the inability to specify env. vars. directly.
- `(make-forkexec-constructor
- ,bash-bin "-c"
- ,(string-append "SLIM_CFGFILE=" (derivation->output-path slim.cfg)
- " " slim-bin
- " -nodaemon")))
- (stop `(make-kill-destructor))
- (inputs `(("slim" ,slim)
- ("slim.cfg" ,slim.cfg)
- ("bash" ,bash)))
+ #~(make-forkexec-constructor
+ (string-append #$bash "/bin/sh") "-c"
+ (string-append "SLIM_CFGFILE=" #$slim.cfg
+ " " #$slim "/bin/slim" " -nodaemon")))
+ (stop #~(make-kill-destructor))
(respawn? #t)
(pam-services
;; Tell PAM about 'slim'.
diff --git a/gnu/system.scm b/gnu/system.scm
index 65b524d387..20c49c182a 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -192,29 +192,6 @@ as an inputs; additional inputs, such as derivations, are taken from INPUTS."
#:inputs inputs
#:local-build? #t))))
-(define (links inputs)
- "Return a directory with symbolic links to all of INPUTS. This is
-essentially useful when one wants to keep references to all of INPUTS, be they
-directories or regular files."
- (define builder
- '(begin
- (use-modules (srfi srfi-1))
-
- (let ((out (assoc-ref %outputs "out")))
- (mkdir out)
- (chdir out)
- (fold (lambda (file number)
- (symlink file (number->string number))
- (+ 1 number))
- 0
- (map cdr %build-inputs))
- #t)))
-
- (mlet %store-monad ((inputs (lower-inputs inputs)))
- (derivation-expression "links" builder
- #:inputs inputs
- #:local-build? #t)))
-
(define* (etc-directory #:key
(locale "C") (timezone "Europe/Paris")
(accounts '())
@@ -272,12 +249,14 @@ alias ll='ls -l'
("shells" ,shells)
("profile" ,(derivation->output-path bashrc))
("localtime" ,tz-file)
- ("passwd" ,passwd)
- ("shadow" ,shadow)
+ ("passwd" ,(derivation->output-path passwd))
+ ("shadow" ,(derivation->output-path shadow))
("group" ,group))))
(file-union files
#:inputs `(("net" ,net-base)
("pam.d" ,pam.d)
+ ("passwd" ,passwd)
+ ("shadow" ,shadow)
("bashrc" ,bashrc)
("tzdata" ,tzdata))
#:name "etc")))
@@ -327,8 +306,7 @@ we're running in the final root."
(mlet* %store-monad
((services (sequence %store-monad (operating-system-services os)))
(etc (operating-system-etc-directory os))
- (dmd-conf (dmd-configuration-file services
- (derivation->output-path etc))))
+ (dmd-conf (dmd-configuration-file services etc)))
(gexp->file "boot"
#~(execl (string-append #$dmd "/bin/dmd")
"dmd" "--config" #$dmd-conf))))
@@ -357,25 +335,19 @@ we're running in the final root."
(linux-arguments `("--root=/dev/sda1"
,(string-append "--load=" boot)))
(initrd initrd-file))))
- (grub.cfg (grub-configuration-file entries))
- (accounts (operating-system-accounts os))
- (extras (links (delete-duplicates
- (append (append-map service-inputs services)
- (append-map user-account-inputs accounts))))))
+ (grub.cfg (grub-configuration-file entries)))
(file-union `(("boot" ,boot)
("kernel" ,kernel-dir)
("initrd" ,initrd-file)
("profile" ,profile)
("grub.cfg" ,grub.cfg)
- ("etc" ,etc)
- ("system-inputs" ,(derivation->output-path extras)))
+ ("etc" ,etc))
#:inputs `(("boot" ,boot-drv)
("kernel" ,kernel)
("initrd" ,initrd)
("bash" ,bash)
("profile" ,profile-drv)
- ("etc" ,etc-drv)
- ("system-inputs" ,extras))
+ ("etc" ,etc-drv))
#:name "system")))
;;; system.scm ends here
diff --git a/gnu/system/linux.scm b/gnu/system/linux.scm
index 65868ce9bf..efe27c55c3 100644
--- a/gnu/system/linux.scm
+++ b/gnu/system/linux.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -21,6 +21,7 @@
#:use-module (guix records)
#:use-module (guix derivations)
#:use-module (guix monads)
+ #:use-module (guix gexp)
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
@@ -58,58 +59,56 @@
(define-record-type* <pam-entry> pam-entry
make-pam-entry
pam-entry?
- (control pam-entry-control) ; string
- (module pam-entry-module) ; file name
- (arguments pam-entry-arguments ; list of strings
+ (control pam-entry-control) ; string
+ (module pam-entry-module) ; file name
+ (arguments pam-entry-arguments ; list of string-valued g-expressions
(default '())))
(define (pam-service->configuration service)
- "Return the configuration string for SERVICE, to be dumped in
-/etc/pam.d/NAME, where NAME is the name of SERVICE."
- (define (entry->string type entry)
+ "Return the derivation building the configuration file for SERVICE, to be
+dumped in /etc/pam.d/NAME, where NAME is the name of SERVICE."
+ (define (entry->gexp type entry)
(match entry
(($ <pam-entry> control module (arguments ...))
- (string-append type " "
- control " " module " "
- (string-join arguments)
- "\n"))))
+ #~(format #t "~a ~a ~a ~a~%"
+ #$type #$control #$module
+ (string-join (list #$@arguments))))))
(match service
(($ <pam-service> name account auth password session)
- (string-concatenate
- (append (map (cut entry->string "account" <>) account)
- (map (cut entry->string "auth" <>) auth)
- (map (cut entry->string "password" <>) password)
- (map (cut entry->string "session" <>) session))))))
+ (define builder
+ #~(begin
+ (with-output-to-file #$output
+ (lambda ()
+ #$@(append (map (cut entry->gexp "account" <>) account)
+ (map (cut entry->gexp "auth" <>) auth)
+ (map (cut entry->gexp "password" <>) password)
+ (map (cut entry->gexp "session" <>) session))
+ #t))))
+
+ (gexp->derivation name builder))))
(define (pam-services->directory services)
"Return the derivation to build the configuration directory to be used as
/etc/pam.d for SERVICES."
(mlet %store-monad
((names -> (map pam-service-name services))
- (files (mapm %store-monad
- (match-lambda
- ((and service ($ <pam-service> name))
- (let ((config (pam-service->configuration service)))
- (text-file (string-append name ".pam") config))))
-
- ;; XXX: Eventually, SERVICES may be a list of monadic
- ;; values instead of plain values.
- (map return services))))
+ (files (sequence %store-monad
+ (map pam-service->configuration
+ ;; XXX: Eventually, SERVICES may be a list of
+ ;; monadic values instead of plain values.
+ services))))
(define builder
- '(begin
- (use-modules (ice-9 match))
+ #~(begin
+ (use-modules (ice-9 match))
- (let ((out (assoc-ref %outputs "out")))
- (mkdir out)
- (for-each (match-lambda
- ((name . file)
- (symlink file (string-append out "/" name))))
- %build-inputs)
- #t)))
+ (mkdir #$output)
+ (for-each (match-lambda
+ ((name file)
+ (symlink file (string-append #$output "/" name))))
+ '#$(zip names files))))
- (derivation-expression "pam.d" builder
- #:inputs (zip names files))))
+ (gexp->derivation "pam.d" builder)))
(define %pam-other-services
;; The "other" PAM configuration, which denies everything (see
@@ -149,7 +148,8 @@ should be the name of a file used as the message-of-the-day."
(pam-entry
(control "optional")
(module "pam_motd.so")
- (arguments (list (string-append "motd=" motd)))))
+ (arguments
+ (list #~(string-append "motd=" #$motd)))))
(list unix))))))))
;;; linux.scm ends here
diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm
index 2a85a20ebb..52242ee4e0 100644
--- a/gnu/system/shadow.scm
+++ b/gnu/system/shadow.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -20,6 +20,7 @@
#:use-module (guix store)
#:use-module (guix records)
#:use-module (guix packages)
+ #:use-module (guix gexp)
#:use-module (guix monads)
#:use-module ((gnu packages admin)
#:select (shadow))
@@ -35,7 +36,6 @@
user-account-comment
user-account-home-directory
user-account-shell
- user-account-inputs
user-group
user-group?
@@ -63,9 +63,8 @@
(gid user-account-gid)
(comment user-account-comment (default ""))
(home-directory user-account-home-directory)
- (shell user-account-shell ; monadic value
- (default (package-file bash "bin/bash")))
- (inputs user-account-inputs (default `(("bash" ,bash)))))
+ (shell user-account-shell ; gexp
+ (default #~(string-append #$bash "/bin/bash"))))
(define-record-type* <user-group>
user-group make-user-group
@@ -97,29 +96,22 @@
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)
- (with-monad %store-monad
- (let loop ((accounts accounts)
- (result '()))
- (match accounts
- ((($ <user-account> 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)))))))
+ (define account-exp
+ (match-lambda
+ (($ <user-account> name pass uid gid comment home-dir shell)
+ (if shadow? ; XXX: use (crypt PASS …)?
+ #~(format #t "~a::::::::~%" #$name)
+ #~(format #t "~a:x:~a:~a:~a:~a:~a~%"
+ #$name #$(number->string uid) #$(number->string gid)
+ #$comment #$home-dir #$shell)))))
- (mlet %store-monad ((contents (contents)))
- (text-file (if shadow? "shadow" "passwd") contents)))
+ (define builder
+ #~(begin
+ (with-output-to-file #$output
+ (lambda ()
+ #$@(map account-exp accounts)
+ #t))))
+
+ (gexp->derivation (if shadow? "shadow" "passwd") builder))
;;; shadow.scm ends here
generated by cgit v1.2.3 (git 2.45.0) at 2024-11-17 18:11:01 +0000