diff options
author | Ludovic Courtès <ludo@gnu.org> | 2015-09-19 12:12:29 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2015-10-10 22:46:15 +0200 |
commit | e79467f63a06811ba5dd8c8b0cc79553c5dd4e3a (patch) | |
tree | 03e0c0895efdf63efc6aea353e08f25bb09ca80d | |
parent | f3f427c2e930e2fb1a72ff8bb9b4a870edfbf007 (diff) | |
download | guix-e79467f63a06811ba5dd8c8b0cc79553c5dd4e3a.tar guix-e79467f63a06811ba5dd8c8b0cc79553c5dd4e3a.tar.gz |
system: Account skeleton API is non-monadic.
* gnu/system/shadow.scm (default-skeletons): Use the non-monadic
procedures and turn into a regular procedure.
(skeleton-directory): Likewise.
* gnu/system.scm (etc-directory): Adjust accordingly.
-rw-r--r-- | gnu/system.scm | 2 | ||||
-rw-r--r-- | gnu/system/shadow.scm | 60 |
2 files changed, 30 insertions, 32 deletions
diff --git a/gnu/system.scm b/gnu/system.scm index cb0ee90e09..5eaafed6ae 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -527,7 +527,7 @@ then # as those in ~/.guix-profile and /run/current-system/profile. source /run/current-system/profile/etc/profile.d/bash_completion.sh fi\n")) - (skel (skeleton-directory skeletons))) + (skel -> (skeleton-directory skeletons))) (file-union "etc" `(("services" ,#~(string-append #$net-base "/etc/services")) ("protocols" ,#~(string-append #$net-base "/etc/protocols")) diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm index f033109614..ddd5f66874 100644 --- a/gnu/system/shadow.scm +++ b/gnu/system/shadow.scm @@ -20,7 +20,6 @@ #:use-module (guix records) #:use-module (guix gexp) #:use-module (guix store) - #:use-module (guix monads) #:use-module (guix sets) #:use-module (guix ui) #:use-module ((gnu system file-systems) @@ -133,10 +132,10 @@ (copy-file (car (find-files #$guile-wm "wm-init-sample.scm")) #$output))) - (mlet %store-monad ((profile (text-file "bash_profile" "\ + (let ((profile (plain-file "bash_profile" "\ # Honor per-interactive-shell startup file if [ -f ~/.bashrc ]; then . ~/.bashrc; fi\n")) - (bashrc (text-file "bashrc" "\ + (bashrc (plain-file "bashrc" "\ # Bash initialization for interactive non-login shells and # for remote shells (info \"(bash) Bash Startup Files\"). @@ -162,42 +161,41 @@ else fi alias ls='ls -p --color' alias ll='ls -l'\n")) - (zlogin (text-file "zlogin" "\ + (zlogin (plain-file "zlogin" "\ # Honor system-wide environment variables source /etc/profile\n")) - (guile-wm (gexp->derivation "guile-wm" copy-guile-wm - #:modules - '((guix build utils)))) - (xdefaults (text-file "Xdefaults" "\ + (guile-wm (computed-file "guile-wm" copy-guile-wm + #:modules '((guix build utils)))) + (xdefaults (plain-file "Xdefaults" "\ XTerm*utf8: always XTerm*metaSendsEscape: true\n")) - (gdbinit (text-file "gdbinit" "\ + (gdbinit (plain-file "gdbinit" "\ # Tell GDB where to look for separate debugging files. set debug-file-directory ~/.guix-profile/lib/debug\n"))) - (return `((".bash_profile" ,profile) - (".bashrc" ,bashrc) - (".zlogin" ,zlogin) - (".Xdefaults" ,xdefaults) - (".guile-wm" ,guile-wm) - (".gdbinit" ,gdbinit))))) + `((".bash_profile" ,profile) + (".bashrc" ,bashrc) + (".zlogin" ,zlogin) + (".Xdefaults" ,xdefaults) + (".guile-wm" ,guile-wm) + (".gdbinit" ,gdbinit)))) (define (skeleton-directory skeletons) - "Return a directory containing SKELETONS, a list of name/derivation pairs." - (gexp->derivation "skel" - #~(begin - (use-modules (ice-9 match)) - - (mkdir #$output) - (chdir #$output) - - ;; Note: copy the skeletons instead of symlinking - ;; them like 'file-union' does, because 'useradd' - ;; would just copy the symlinks as is. - (for-each (match-lambda - ((target source) - (copy-file source target))) - '#$skeletons) - #t))) + "Return a directory containing SKELETONS, a list of name/derivation tuples." + (computed-file "skel" + #~(begin + (use-modules (ice-9 match)) + + (mkdir #$output) + (chdir #$output) + + ;; Note: copy the skeletons instead of symlinking + ;; them like 'file-union' does, because 'useradd' + ;; would just copy the symlinks as is. + (for-each (match-lambda + ((target source) + (copy-file source target))) + '#$skeletons) + #t))) (define (assert-valid-users/groups users groups) "Raise an error if USERS refer to groups not listed in GROUPS." |