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) | |
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 cb0ee90e097..5eaafed6ae2 100644 --- a/gnu/system.scm +++ b/gnu/system.scm | |||
| @@ -527,7 +527,7 @@ then | |||
| 527 | # as those in ~/.guix-profile and /run/current-system/profile. | 527 | # as those in ~/.guix-profile and /run/current-system/profile. |
| 528 | source /run/current-system/profile/etc/profile.d/bash_completion.sh | 528 | source /run/current-system/profile/etc/profile.d/bash_completion.sh |
| 529 | fi\n")) | 529 | fi\n")) |
| 530 | (skel (skeleton-directory skeletons))) | 530 | (skel -> (skeleton-directory skeletons))) |
| 531 | (file-union "etc" | 531 | (file-union "etc" |
| 532 | `(("services" ,#~(string-append #$net-base "/etc/services")) | 532 | `(("services" ,#~(string-append #$net-base "/etc/services")) |
| 533 | ("protocols" ,#~(string-append #$net-base "/etc/protocols")) | 533 | ("protocols" ,#~(string-append #$net-base "/etc/protocols")) |
diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm index f0331096140..ddd5f668743 100644 --- a/gnu/system/shadow.scm +++ b/gnu/system/shadow.scm | |||
| @@ -20,7 +20,6 @@ | |||
| 20 | #:use-module (guix records) | 20 | #:use-module (guix records) |
| 21 | #:use-module (guix gexp) | 21 | #:use-module (guix gexp) |
| 22 | #:use-module (guix store) | 22 | #:use-module (guix store) |
| 23 | #:use-module (guix monads) | ||
| 24 | #:use-module (guix sets) | 23 | #:use-module (guix sets) |
| 25 | #:use-module (guix ui) | 24 | #:use-module (guix ui) |
| 26 | #:use-module ((gnu system file-systems) | 25 | #:use-module ((gnu system file-systems) |
| @@ -133,10 +132,10 @@ | |||
| 133 | (copy-file (car (find-files #$guile-wm "wm-init-sample.scm")) | 132 | (copy-file (car (find-files #$guile-wm "wm-init-sample.scm")) |
| 134 | #$output))) | 133 | #$output))) |
| 135 | 134 | ||
| 136 | (mlet %store-monad ((profile (text-file "bash_profile" "\ | 135 | (let ((profile (plain-file "bash_profile" "\ |
| 137 | # Honor per-interactive-shell startup file | 136 | # Honor per-interactive-shell startup file |
| 138 | if [ -f ~/.bashrc ]; then . ~/.bashrc; fi\n")) | 137 | if [ -f ~/.bashrc ]; then . ~/.bashrc; fi\n")) |
| 139 | (bashrc (text-file "bashrc" "\ | 138 | (bashrc (plain-file "bashrc" "\ |
| 140 | # Bash initialization for interactive non-login shells and | 139 | # Bash initialization for interactive non-login shells and |
| 141 | # for remote shells (info \"(bash) Bash Startup Files\"). | 140 | # for remote shells (info \"(bash) Bash Startup Files\"). |
| 142 | 141 | ||
| @@ -162,42 +161,41 @@ else | |||
| 162 | fi | 161 | fi |
| 163 | alias ls='ls -p --color' | 162 | alias ls='ls -p --color' |
| 164 | alias ll='ls -l'\n")) | 163 | alias ll='ls -l'\n")) |
| 165 | (zlogin (text-file "zlogin" "\ | 164 | (zlogin (plain-file "zlogin" "\ |
| 166 | # Honor system-wide environment variables | 165 | # Honor system-wide environment variables |
| 167 | source /etc/profile\n")) | 166 | source /etc/profile\n")) |
| 168 | (guile-wm (gexp->derivation "guile-wm" copy-guile-wm | 167 | (guile-wm (computed-file "guile-wm" copy-guile-wm |
| 169 | #:modules | 168 | #:modules '((guix build utils)))) |
| 170 | '((guix build utils)))) | 169 | (xdefaults (plain-file "Xdefaults" "\ |
| 171 | (xdefaults (text-file "Xdefaults" "\ | ||
| 172 | XTerm*utf8: always | 170 | XTerm*utf8: always |
| 173 | XTerm*metaSendsEscape: true\n")) | 171 | XTerm*metaSendsEscape: true\n")) |
| 174 | (gdbinit (text-file "gdbinit" "\ | 172 | (gdbinit (plain-file "gdbinit" "\ |
| 175 | # Tell GDB where to look for separate debugging files. | 173 | # Tell GDB where to look for separate debugging files. |
| 176 | set debug-file-directory ~/.guix-profile/lib/debug\n"))) | 174 | set debug-file-directory ~/.guix-profile/lib/debug\n"))) |
| 177 | (return `((".bash_profile" ,profile) | 175 | `((".bash_profile" ,profile) |
| 178 | (".bashrc" ,bashrc) | 176 | (".bashrc" ,bashrc) |
| 179 | (".zlogin" ,zlogin) | 177 | (".zlogin" ,zlogin) |
| 180 | (".Xdefaults" ,xdefaults) | 178 | (".Xdefaults" ,xdefaults) |
| 181 | (".guile-wm" ,guile-wm) | 179 | (".guile-wm" ,guile-wm) |
| 182 | (".gdbinit" ,gdbinit))))) | 180 | (".gdbinit" ,gdbinit)))) |
| 183 | 181 | ||
| 184 | (define (skeleton-directory skeletons) | 182 | (define (skeleton-directory skeletons) |
| 185 | "Return a directory containing SKELETONS, a list of name/derivation pairs." | 183 | "Return a directory containing SKELETONS, a list of name/derivation tuples." |
| 186 | (gexp->derivation "skel" | 184 | (computed-file "skel" |
| 187 | #~(begin | 185 | #~(begin |
| 188 | (use-modules (ice-9 match)) | 186 | (use-modules (ice-9 match)) |
| 189 | 187 | ||
| 190 | (mkdir #$output) | 188 | (mkdir #$output) |
| 191 | (chdir #$output) | 189 | (chdir #$output) |
| 192 | 190 | ||
| 193 | ;; Note: copy the skeletons instead of symlinking | 191 | ;; Note: copy the skeletons instead of symlinking |
| 194 | ;; them like 'file-union' does, because 'useradd' | 192 | ;; them like 'file-union' does, because 'useradd' |
| 195 | ;; would just copy the symlinks as is. | 193 | ;; would just copy the symlinks as is. |
| 196 | (for-each (match-lambda | 194 | (for-each (match-lambda |
| 197 | ((target source) | 195 | ((target source) |
| 198 | (copy-file source target))) | 196 | (copy-file source target))) |
| 199 | '#$skeletons) | 197 | '#$skeletons) |
| 200 | #t))) | 198 | #t))) |
| 201 | 199 | ||
| 202 | (define (assert-valid-users/groups users groups) | 200 | (define (assert-valid-users/groups users groups) |
| 203 | "Raise an error if USERS refer to groups not listed in GROUPS." | 201 | "Raise an error if USERS refer to groups not listed in GROUPS." |
