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)
|
(define (dot-or-dot-dot? file)
|
||||||
(member 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
|
(define* (copy-account-skeletons home
|
||||||
#:optional (directory %skeleton-directory))
|
#:optional (directory %skeleton-directory))
|
||||||
"Copy the account skeletons from DIRECTORY to HOME."
|
"Copy the account skeletons from DIRECTORY to HOME."
|
||||||
|
@ -85,8 +90,21 @@
|
||||||
string<?)))
|
string<?)))
|
||||||
(mkdir-p home)
|
(mkdir-p home)
|
||||||
(for-each (lambda (file)
|
(for-each (lambda (file)
|
||||||
(copy-file (string-append directory "/" file)
|
(let ((target (string-append home "/" file)))
|
||||||
(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)))
|
files)))
|
||||||
|
|
||||||
(define* (add-user name group
|
(define* (add-user name group
|
||||||
|
@ -128,7 +146,14 @@ properties. Return #t on success."
|
||||||
,@(if password `("-p" ,password) '())
|
,@(if password `("-p" ,password) '())
|
||||||
,@(if system? '("--system") '())
|
,@(if system? '("--system") '())
|
||||||
,name)))
|
,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
|
(define* (modify-user name group
|
||||||
#:key uid comment home shell password system?
|
#:key uid comment home shell password system?
|
||||||
|
|
Loading…
Reference in New Issue