diff options
Diffstat (limited to 'gnu/build')
| -rw-r--r-- | gnu/build/activation.scm | 39 | ||||
| -rw-r--r-- | gnu/build/install.scm | 16 | ||||
| -rw-r--r-- | gnu/build/linux-boot.scm | 1 |
3 files changed, 46 insertions, 10 deletions
diff --git a/gnu/build/activation.scm b/gnu/build/activation.scm index 0c60355a1c..352e736050 100644 --- a/gnu/build/activation.scm +++ b/gnu/build/activation.scm @@ -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? @@ -344,9 +369,11 @@ found in Linux 3.4 onward that prevents users from attaching to their own processes--see Yama.txt in the Linux source tree for the rationale. This sounds like an unacceptable restriction for little or no security improvement." - (call-with-output-file "/proc/sys/kernel/yama/ptrace_scope" - (lambda (port) - (display 0 port)))) + (let ((file "/proc/sys/kernel/yama/ptrace_scope")) + (when (file-exists? file) + (call-with-output-file file + (lambda (port) + (display 0 port)))))) (define %current-system diff --git a/gnu/build/install.scm b/gnu/build/install.scm index 76536daf49..32fbe8efbc 100644 --- a/gnu/build/install.scm +++ b/gnu/build/install.scm @@ -133,9 +133,19 @@ includes /etc, /var, /run, /bin/sh, etc., and all the symlinks to SYSTEM." (directives (%store-directory))) ;; Add system generation 1. - (false-if-exception (delete-file "/var/guix/profiles/system-1-link")) - (symlink system - (string-append target "/var/guix/profiles/system-1-link"))) + (let ((generation-1 (string-append target + "/var/guix/profiles/system-1-link"))) + (let try () + (catch 'system-error + (lambda () + (symlink system generation-1)) + (lambda args + ;; If GENERATION-1 already exists, overwrite it. + (if (= EEXIST (system-error-errno args)) + (begin + (delete-file generation-1) + (try)) + (apply throw args))))))) (define (reset-timestamps directory) "Reset the timestamps of all the files under DIRECTORY, so that they appear diff --git a/gnu/build/linux-boot.scm b/gnu/build/linux-boot.scm index f54e3d3a35..3081a93a97 100644 --- a/gnu/build/linux-boot.scm +++ b/gnu/build/linux-boot.scm @@ -418,7 +418,6 @@ to it are lost." (switch-root "/root") (format #t "loading '~a'...\n" to-load) - ;; TODO: Remove /lib, /share, and /loader.go. (primitive-load to-load) (format (current-error-port) |