~ruther/guix-local

356a62b8e650867d107773120c33531ea429f189 — Ludovic Courtès 11 years ago 68267c6
activation: Make user copies of the skeletons writable.

* gnu/build/activation.scm (make-file-writable,
  make-skeletons-writable): New procedures.
  (copy-account-skeletons): Call 'make-file-writable' after 'copy-file'.
  (add-user): Add call to 'make-skeletons-writable'.
1 files changed, 28 insertions(+), 3 deletions(-)

M gnu/build/activation.scm
M gnu/build/activation.scm => gnu/build/activation.scm +28 -3
@@ 78,6 78,11 @@
(define (dot-or-dot-dot? file)
  (member file '("." "..")))

(define (make-file-writable file)
  "Make FILE writable for its owner.."
  (let ((stat (lstat file)))                      ;XXX: symlinks
    (chmod file (logior #o600 (stat:perms stat)))))

(define* (copy-account-skeletons home
                                 #:optional (directory %skeleton-directory))
  "Copy the account skeletons from DIRECTORY to HOME."


@@ 85,8 90,21 @@
                        string<?)))
    (mkdir-p home)
    (for-each (lambda (file)
                (copy-file (string-append directory "/" file)
                           (string-append home "/" file)))
                (let ((target (string-append home "/" file)))
                  (copy-file (string-append directory "/" file) target)
                  (make-file-writable target)))
              files)))

(define* (make-skeletons-writable home
                                  #:optional (directory %skeleton-directory))
  "Make sure that the files that have been copied from DIRECTORY to HOME are
owner-writable in HOME."
  (let ((files (scandir directory (negate dot-or-dot-dot?)
                        string<?)))
    (for-each (lambda (file)
                (let ((target (string-append home "/" file)))
                  (when (file-exists? target)
                    (make-file-writable target))))
              files)))

(define* (add-user name group


@@ 128,7 146,14 @@ properties.  Return #t on success."
                    ,@(if password `("-p" ,password) '())
                    ,@(if system? '("--system") '())
                    ,name)))
        (zero? (apply system* "useradd" args)))))
        (and (zero? (apply system* "useradd" args))
             (begin
               ;; Since /etc/skel is a link to a directory in the store where
               ;; all files have the writable bit cleared, and since 'useradd'
               ;; preserves permissions when it copies them, explicitly make
               ;; them writable.
               (make-skeletons-writable home)
               #t)))))

(define* (modify-user name group
                      #:key uid comment home shell password system?