diff options
Diffstat (limited to 'gnu/build/activation.scm')
| -rw-r--r-- | gnu/build/activation.scm | 82 |
1 files changed, 52 insertions, 30 deletions
diff --git a/gnu/build/activation.scm b/gnu/build/activation.scm index 362669cbf9..04dd19f3e1 100644 --- a/gnu/build/activation.scm +++ b/gnu/build/activation.scm @@ -26,6 +26,7 @@ #:export (activate-users+groups activate-etc activate-setuid-programs + activate-/bin/sh activate-current-system)) ;;; Commentary: @@ -146,48 +147,64 @@ numeric gid or #f." ;; /etc is a mixture of static and dynamic settings. Here is where we ;; initialize it from the static part. + (define (rm-f file) + (false-if-exception (delete-file file))) + (format #t "populating /etc from ~a...~%" etc) - (let ((rm-f (lambda (f) - (false-if-exception (delete-file f))))) - (rm-f "/etc/static") - (symlink etc "/etc/static") - (for-each (lambda (file) - ;; TODO: Handle 'shadow' specially so that changed - ;; password aren't lost. - (let ((target (string-append "/etc/" file)) - (source (string-append "/etc/static/" file))) - (rm-f target) - (symlink source target))) - (scandir etc - (lambda (file) - (not (member file '("." "..")))) - - ;; The default is 'string-locale<?', but we don't have - ;; it when run from the initrd's statically-linked - ;; Guile. - string<?)) - - ;; Prevent ETC from being GC'd. - (rm-f "/var/guix/gcroots/etc-directory") - (symlink etc "/var/guix/gcroots/etc-directory"))) + + (rm-f "/etc/static") + (symlink etc "/etc/static") + (for-each (lambda (file) + (let ((target (string-append "/etc/" file)) + (source (string-append "/etc/static/" file))) + (rm-f target) + + ;; Things such as /etc/sudoers must be regular files, not + ;; symlinks; furthermore, they could be modified behind our + ;; back---e.g., with 'visudo'. Thus, make a copy instead of + ;; symlinking them. + (if (file-is-directory? source) + (symlink source target) + (copy-file source target)) + + ;; XXX: Dirty hack to meet sudo's expectations. + (when (string=? (basename target) "sudoers") + (chmod target #o440)))) + (scandir etc + (lambda (file) + (not (member file '("." "..")))) + + ;; The default is 'string-locale<?', but we don't have + ;; it when run from the initrd's statically-linked + ;; Guile. + string<?)) + + ;; Prevent ETC from being GC'd. + (rm-f "/var/guix/gcroots/etc-directory") + (symlink etc "/var/guix/gcroots/etc-directory")) (define %setuid-directory ;; Place where setuid programs are stored. "/run/setuid-programs") +(define (link-or-copy source target) + "Attempt to make TARGET a hard link to SOURCE; if it fails, fall back to +copy SOURCE to TARGET." + (catch 'system-error + (lambda () + (link source target)) + (lambda args + ;; Perhaps SOURCE and TARGET live in a different file system, so copy + ;; SOURCE. + (copy-file source target)))) + (define (activate-setuid-programs programs) "Turn PROGRAMS, a list of file names, into setuid programs stored under %SETUID-DIRECTORY." (define (make-setuid-program prog) (let ((target (string-append %setuid-directory "/" (basename prog)))) - (catch 'system-error - (lambda () - (link prog target)) - (lambda args - ;; Perhaps PROG and TARGET live in a different file system, so copy - ;; PROG. - (copy-file prog target))) + (link-or-copy prog target) (chown target 0 0) (chmod target #o6555))) @@ -204,6 +221,11 @@ numeric gid or #f." (for-each make-setuid-program programs)) +(define (activate-/bin/sh shell) + "Change /bin/sh to point to SHELL." + (symlink shell "/bin/sh.new") + (rename-file "/bin/sh.new" "/bin/sh")) + (define %current-system ;; The system that is current (a symlink.) This is not necessarily the same ;; as the system we booted (aka. /run/booted-system) because we can re-build |