diff options
author | Ludovic Courtès <ludo@gnu.org> | 2014-04-23 15:47:42 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2014-04-23 15:47:42 +0200 |
commit | 0b6f49ef69b4429e05f6e76ccd2ee9e1d07e7776 (patch) | |
tree | adc729c5d6fe80074015d918461433ab77170d31 /gnu | |
parent | 42b001381e2d892d9c3ac68d3bf3b89c553699a2 (diff) | |
download | guix-0b6f49ef69b4429e05f6e76ccd2ee9e1d07e7776.tar.gz |
system: Factorize (gnu system).
* gnu/system.scm (operating-system-accounts, operating-system-etc-directory): New procedures. (operating-system-derivation): Use them. * gnu/services/base.scm (%base-services): Add 'host-name-service' invocation.
Diffstat (limited to 'gnu')
-rw-r--r-- | gnu/services/base.scm | 5 | ||||
-rw-r--r-- | gnu/system.scm | 59 |
2 files changed, 38 insertions, 26 deletions
diff --git a/gnu/services/base.scm b/gnu/services/base.scm index d6c1707c6a..3145a657f8 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -186,6 +186,9 @@ This is the GNU operating system, welcome!\n\n"))) (mingetty-service "tty6" #:motd motd) (syslog-service) (guix-service) - (nscd-service)))) + (nscd-service) + + ;; FIXME: Make this an activation-time thing instead of a service. + (host-name-service "gnu")))) ;;; base.scm ends here diff --git a/gnu/system.scm b/gnu/system.scm index 96f721330f..0c330f1564 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -292,42 +292,50 @@ alias ll='ls -l' (mlet %store-monad ((drv (operating-system-profile-derivation os))) (return (derivation->output-path drv)))) -(define (operating-system-derivation os) - "Return a derivation that builds OS." +(define (operating-system-accounts os) + "Return the user accounts for OS, including an obligatory 'root' account." + (mlet %store-monad ((services (sequence %store-monad + (operating-system-services os)))) + (return (cons (user-account + (name "root") + (password "") + (uid 0) (gid 0) + (comment "System administrator") + (home-directory "/root")) + (append (operating-system-users os) + (append-map service-user-accounts + services)))))) + +(define (operating-system-etc-directory os) + "Return that static part of the /etc directory of OS." (mlet* %store-monad - ((services (sequence %store-monad - (cons (host-name-service - (operating-system-host-name os)) - (operating-system-services os)))) + ((services (sequence %store-monad (operating-system-services os))) (pam-services -> ;; Services known to PAM. (delete-duplicates (cons %pam-other-services (append-map service-pam-services services)))) - - (bash-file (package-file bash "bin/bash")) - (dmd-file (package-file (@ (gnu packages admin) dmd) "bin/dmd")) - (accounts -> (cons (user-account - (name "root") - (password "") - (uid 0) (gid 0) - (comment "System administrator") - (home-directory "/root")) - (append (operating-system-users os) - (append-map service-user-accounts - services)))) + (accounts (operating-system-accounts os)) + (profile-drv (operating-system-profile-derivation os)) (groups -> (append (operating-system-groups os) - (append-map service-user-groups services))) + (append-map service-user-groups services)))) + (etc-directory #:accounts accounts #:groups groups + #:pam-services pam-services + #:locale (operating-system-locale os) + #:timezone (operating-system-timezone os) + #:profile profile-drv))) +(define (operating-system-derivation os) + "Return a derivation that builds OS." + (mlet* %store-monad + ((bash-file (package-file bash "bin/bash")) + (dmd-file (package-file (@ (gnu packages admin) dmd) "bin/dmd")) (profile-drv (operating-system-profile-derivation os)) (profile -> (derivation->output-path profile-drv)) - (etc-drv (etc-directory #:accounts accounts #:groups groups - #:pam-services pam-services - #:locale (operating-system-locale os) - #:timezone (operating-system-timezone os) - #:profile profile-drv)) + (etc-drv (operating-system-etc-directory os)) (etc -> (derivation->output-path etc-drv)) - (dmd-conf (dmd-configuration-file services etc)) + (services (sequence %store-monad (operating-system-services os))) + (dmd-conf (dmd-configuration-file services etc)) (boot (text-file "boot" @@ -349,6 +357,7 @@ alias ll='ls -l' ,(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)))))) |