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'.
This commit is contained in:
parent
68267c6367
commit
356a62b8e6
|
@ -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?
|
||||
|
|
Loading…
Reference in New Issue