summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-09-19 12:12:29 +0200
committerLudovic Courtès <ludo@gnu.org>2015-10-10 22:46:15 +0200
commite79467f63a06811ba5dd8c8b0cc79553c5dd4e3a (patch)
tree03e0c0895efdf63efc6aea353e08f25bb09ca80d
parentf3f427c2e930e2fb1a72ff8bb9b4a870edfbf007 (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.scm2
-rw-r--r--gnu/system/shadow.scm60
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
529fi\n")) 529fi\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
138if [ -f ~/.bashrc ]; then . ~/.bashrc; fi\n")) 137if [ -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
162fi 161fi
163alias ls='ls -p --color' 162alias ls='ls -p --color'
164alias ll='ls -l'\n")) 163alias 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
167source /etc/profile\n")) 166source /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" "\
172XTerm*utf8: always 170XTerm*utf8: always
173XTerm*metaSendsEscape: true\n")) 171XTerm*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.
176set debug-file-directory ~/.guix-profile/lib/debug\n"))) 174set 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."