ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 05:18:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

activation: Make user copies of the skeletons writable.

Browse source 
* 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'.
This commit is contained in:
Ludovic Courtès 2015-05-05 23:46:54 +02:00
parent 68267c6367
commit 356a62b8e6
1 changed files with 28 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

31
gnu/build/activation.scm
View file

@ -78,6 +78,11 @@ (define %skeleton-directory
(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 @@ (define* (copy-account-skeletons home
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 @@ (define* (add-user name group
,@(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?