nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests 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. # as those in ~/.guix-profile and /run/current-system/profile.
source /run/current-system/profile/etc/profile.d/bash_completion.sh source /run/current-system/profile/etc/profile.d/bash_completion.sh
fi\n")) fi\n"))
(skel (skeleton-directory skeletons))) (skel -> (skeleton-directory skeletons)))
(file-union "etc" (file-union "etc"
`(("services" ,#~(string-append #$net-base "/etc/services")) `(("services" ,#~(string-append #$net-base "/etc/services"))
("protocols" ,#~(string-append #$net-base "/etc/protocols")) ("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 records)
#:use-module (guix gexp) #:use-module (guix gexp)
#:use-module (guix store) #:use-module (guix store)
#:use-module (guix monads)
#:use-module (guix sets) #:use-module (guix sets)
#:use-module (guix ui) #:use-module (guix ui)
#:use-module ((gnu system file-systems) #:use-module ((gnu system file-systems)
@ -133,10 +132,10 @@
(copy-file (car (find-files #$guile-wm "wm-init-sample.scm")) (copy-file (car (find-files #$guile-wm "wm-init-sample.scm"))
#$output))) #$output)))
(mlet %store-monad ((profile (text-file "bash_profile" "\ (let ((profile (plain-file "bash_profile" "\
# Honor per-interactive-shell startup file # Honor per-interactive-shell startup file
if [ -f ~/.bashrc ]; then . ~/.bashrc; fi\n")) if [ -f ~/.bashrc ]; then . ~/.bashrc; fi\n"))
(bashrc (text-file "bashrc" "\ (bashrc (plain-file "bashrc" "\
# Bash initialization for interactive non-login shells and # Bash initialization for interactive non-login shells and
# for remote shells (info \"(bash) Bash Startup Files\"). # for remote shells (info \"(bash) Bash Startup Files\").
@ -162,42 +161,41 @@ else
fi fi
alias ls='ls -p --color' alias ls='ls -p --color'
alias ll='ls -l'\n")) alias ll='ls -l'\n"))
(zlogin (text-file "zlogin" "\ (zlogin (plain-file "zlogin" "\
# Honor system-wide environment variables # Honor system-wide environment variables
source /etc/profile\n")) source /etc/profile\n"))
(guile-wm (gexp->derivation "guile-wm" copy-guile-wm (guile-wm (computed-file "guile-wm" copy-guile-wm
#:modules #:modules '((guix build utils))))
'((guix build utils)))) (xdefaults (plain-file "Xdefaults" "\
(xdefaults (text-file "Xdefaults" "\
XTerm*utf8: always XTerm*utf8: always
XTerm*metaSendsEscape: true\n")) XTerm*metaSendsEscape: true\n"))
(gdbinit (text-file "gdbinit" "\ (gdbinit (plain-file "gdbinit" "\
# Tell GDB where to look for separate debugging files. # Tell GDB where to look for separate debugging files.
set debug-file-directory ~/.guix-profile/lib/debug\n"))) set debug-file-directory ~/.guix-profile/lib/debug\n")))
(return `((".bash_profile" ,profile) `((".bash_profile" ,profile)
(".bashrc" ,bashrc) (".bashrc" ,bashrc)
(".zlogin" ,zlogin) (".zlogin" ,zlogin)
(".Xdefaults" ,xdefaults) (".Xdefaults" ,xdefaults)
(".guile-wm" ,guile-wm) (".guile-wm" ,guile-wm)
(".gdbinit" ,gdbinit))))) (".gdbinit" ,gdbinit))))
(define (skeleton-directory skeletons) (define (skeleton-directory skeletons)
"Return a directory containing SKELETONS, a list of name/derivation pairs." "Return a directory containing SKELETONS, a list of name/derivation tuples."
(gexp->derivation "skel" (computed-file "skel"
#~(begin #~(begin
(use-modules (ice-9 match)) (use-modules (ice-9 match))
(mkdir #$output) (mkdir #$output)
(chdir #$output) (chdir #$output)
;; Note: copy the skeletons instead of symlinking ;; Note: copy the skeletons instead of symlinking
;; them like 'file-union' does, because 'useradd' ;; them like 'file-union' does, because 'useradd'
;; would just copy the symlinks as is. ;; would just copy the symlinks as is.
(for-each (match-lambda (for-each (match-lambda
((target source) ((target source)
(copy-file source target))) (copy-file source target)))
'#$skeletons) '#$skeletons)
#t))) #t)))
(define (assert-valid-users/groups users groups) (define (assert-valid-users/groups users groups)
"Raise an error if USERS refer to groups not listed in GROUPS." "Raise an error if USERS refer to groups not listed in GROUPS."