TakeV
/
guix
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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.
This commit is contained in:
Ludovic Courtès 2015-09-19 12:12:29 +02:00
parent f3f427c2e9
commit e79467f63a
2 changed files with 28 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
gnu/system.scm
View File

@ -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"))

56
gnu/system/shadow.scm
View File

@ -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))
"Return a directory containing SKELETONS, a list of name/derivation tuples."
(computed-file "skel"
#~(begin
(use-modules (ice-9 match))
(mkdir #$output)
(chdir #$output)
(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)))
;; 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."