diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2017-02-10 17:40:25 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2017-02-10 17:40:25 +0100 |
| commit | 768f0ac9dd9993827430d62d0f72a5020f476892 (patch) | |
| tree | 600f7ca7cedb221147edfc92356e11bc6c56f311 /gnu/build/activation.scm | |
| parent | 955ba55c6bf3a22264b56274ec22cad1551c1ce6 (diff) | |
| parent | 49dbae548e92e0521ae125239282a04d8ea924cf (diff) | |
Merge branch 'master' into core-updates
Diffstat (limited to 'gnu/build/activation.scm')
| -rw-r--r-- | gnu/build/activation.scm | 49 |
1 files changed, 39 insertions, 10 deletions
diff --git a/gnu/build/activation.scm b/gnu/build/activation.scm index d36eeafe47c..beee56d4379 100644 --- a/gnu/build/activation.scm +++ b/gnu/build/activation.scm | |||
| @@ -28,7 +28,7 @@ | |||
| 28 | activate-user-home | 28 | activate-user-home |
| 29 | activate-etc | 29 | activate-etc |
| 30 | activate-setuid-programs | 30 | activate-setuid-programs |
| 31 | activate-/bin/sh | 31 | activate-special-files |
| 32 | activate-modprobe | 32 | activate-modprobe |
| 33 | activate-firmware | 33 | activate-firmware |
| 34 | activate-ptrace-attach | 34 | activate-ptrace-attach |
| @@ -80,16 +80,27 @@ | |||
| 80 | (member file '("." ".."))) | 80 | (member file '("." ".."))) |
| 81 | 81 | ||
| 82 | (define* (copy-account-skeletons home | 82 | (define* (copy-account-skeletons home |
| 83 | #:optional (directory %skeleton-directory)) | 83 | #:key |
| 84 | "Copy the account skeletons from DIRECTORY to HOME." | 84 | (directory %skeleton-directory) |
| 85 | uid gid) | ||
| 86 | "Copy the account skeletons from DIRECTORY to HOME. When UID is an integer, | ||
| 87 | make it the owner of all the files created; likewise for GID." | ||
| 88 | (define (set-owner file) | ||
| 89 | (when (or uid gid) | ||
| 90 | (chown file (or uid -1) (or gid -1)))) | ||
| 91 | |||
| 85 | (let ((files (scandir directory (negate dot-or-dot-dot?) | 92 | (let ((files (scandir directory (negate dot-or-dot-dot?) |
| 86 | string<?))) | 93 | string<?))) |
| 87 | (mkdir-p home) | 94 | (mkdir-p home) |
| 95 | (set-owner home) | ||
| 88 | (for-each (lambda (file) | 96 | (for-each (lambda (file) |
| 89 | (let ((target (string-append home "/" file))) | 97 | (let ((target (string-append home "/" file))) |
| 90 | (copy-recursively (string-append directory "/" file) | 98 | (copy-recursively (string-append directory "/" file) |
| 91 | target | 99 | target |
| 92 | #:log (%make-void-port "w")) | 100 | #:log (%make-void-port "w")) |
| 101 | (for-each set-owner | ||
| 102 | (find-files target (const #t) | ||
| 103 | #:directories? #t)) | ||
| 93 | (make-file-writable target))) | 104 | (make-file-writable target))) |
| 94 | files))) | 105 | files))) |
| 95 | 106 | ||
| @@ -272,9 +283,14 @@ they already exist." | |||
| 272 | ((name uid group supplementary-groups comment home create-home? | 283 | ((name uid group supplementary-groups comment home create-home? |
| 273 | shell password system?) | 284 | shell password system?) |
| 274 | (unless (or (not home) (directory-exists? home)) | 285 | (unless (or (not home) (directory-exists? home)) |
| 275 | (mkdir-p home) | 286 | (let* ((pw (getpwnam name)) |
| 276 | (unless system? | 287 | (uid (passwd:uid pw)) |
| 277 | (copy-account-skeletons home)))))) | 288 | (gid (passwd:gid pw))) |
| 289 | (mkdir-p home) | ||
| 290 | (chown home uid gid) | ||
| 291 | (unless system? | ||
| 292 | (copy-account-skeletons home | ||
| 293 | #:uid uid #:gid gid))))))) | ||
| 278 | 294 | ||
| 279 | (for-each ensure-user-home users)) | 295 | (for-each ensure-user-home users)) |
| 280 | 296 | ||
| @@ -362,10 +378,23 @@ copy SOURCE to TARGET." | |||
| 362 | 378 | ||
| 363 | (for-each make-setuid-program programs)) | 379 | (for-each make-setuid-program programs)) |
| 364 | 380 | ||
| 365 | (define (activate-/bin/sh shell) | 381 | (define (activate-special-files special-files) |
| 366 | "Change /bin/sh to point to SHELL." | 382 | "Install the files listed in SPECIAL-FILES. Each element of SPECIAL-FILES |
| 367 | (symlink shell "/bin/sh.new") | 383 | is a pair where the first element is the name of the special file and the |
| 368 | (rename-file "/bin/sh.new" "/bin/sh")) | 384 | second element is the name it should appear at, such as: |
| 385 | |||
| 386 | ((\"/bin/sh\" \"/gnu/store/…-bash/bin/sh\") | ||
| 387 | (\"/usr/bin/env\" \"/gnu/store/…-coreutils/bin/env\")) | ||
| 388 | " | ||
| 389 | (define install-special-file | ||
| 390 | (match-lambda | ||
| 391 | ((target file) | ||
| 392 | (let ((pivot (string-append target ".new"))) | ||
| 393 | (mkdir-p (dirname target)) | ||
| 394 | (symlink file pivot) | ||
| 395 | (rename-file pivot target))))) | ||
| 396 | |||
| 397 | (for-each install-special-file special-files)) | ||
| 369 | 398 | ||
| 370 | (define (activate-modprobe modprobe) | 399 | (define (activate-modprobe modprobe) |
| 371 | "Tell the kernel to use MODPROBE to load modules." | 400 | "Tell the kernel to use MODPROBE to load modules." |
