~ruther/guix-local

e79467f63a06811ba5dd8c8b0cc79553c5dd4e3a — Ludovic Courtès 10 years ago f3f427c
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.
2 files changed, 30 insertions(+), 32 deletions(-)

M gnu/system.scm
M gnu/system/shadow.scm
M gnu/system.scm => gnu/system.scm +1 -1
@@ 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"))

M gnu/system/shadow.scm => gnu/system/shadow.scm +29 -31
@@ 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."