From cf98d342b0899be3b72438d2dd5a2350f0f78f33 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 3 Feb 2017 09:50:09 +0100 Subject: activation: Set the right owner for home directories. This fixes a regression introduced in ae763b5b0b7d5e7316a3d0efe991fe8ab2261031 whereby home directories and skeletons would be root-owned. * gnu/build/activation.scm (copy-account-skeletons): Make 'directory' a keyword parameter. Add #:uid and #:gid and honor them. [set-owner]: New procedure. (activate-user-home): Add call to 'getpw' and 'chown'. Pass UID and GID to 'copy-account-skeletons'. * gnu/tests/base.scm (run-basic-test)["skeletons in home directories"]: Test file ownership under HOME. --- gnu/tests/base.scm | 36 ++++++++++++++++++++++++++++-------- 1 file changed, 28 insertions(+), 8 deletions(-) (limited to 'gnu/tests') diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm index 756d3df800..8a6a7a1568 100644 --- a/gnu/tests/base.scm +++ b/gnu/tests/base.scm @@ -166,21 +166,41 @@ (define marionette marionette))) (test-assert "skeletons in home directories" - (let ((homes + (let ((users+homes '#$(filter-map (lambda (account) (and (user-account-create-home-directory? account) (not (user-account-system? account)) - (user-account-home-directory account))) + (list (user-account-name account) + (user-account-home-directory + account)))) (operating-system-user-accounts os)))) (marionette-eval `(begin - (use-modules (srfi srfi-1) (ice-9 ftw)) - (every (lambda (home) - (null? (lset-difference string=? - (scandir "/etc/skel/") - (scandir home)))) - ',homes)) + (use-modules (srfi srfi-1) (ice-9 ftw) + (ice-9 match)) + + (every (match-lambda + ((user home) + ;; Make sure HOME has all the skeletons... + (and (null? (lset-difference string=? + (scandir "/etc/skel/") + (scandir home))) + + ;; ... and that everything is user-owned. + (let* ((pw (getpwnam user)) + (uid (passwd:uid pw)) + (gid (passwd:gid pw)) + (st (lstat home))) + (define (user-owned? file) + (= uid (stat:uid (lstat file)))) + + (and (= uid (stat:uid st)) + (eq? 'directory (stat:type st)) + (every user-owned? + (find-files home + #:directories? #t))))))) + ',users+homes)) marionette))) (test-equal "login on tty1" -- cgit v1.2.3 From 387e175492f960d7d86f34f3b2e43938fa72dbf3 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 8 Feb 2017 15:32:28 +0100 Subject: services: Add 'special-files-service-type'. * gnu/build/activation.scm (activate-/bin/sh): Remove. (activate-special-files): New procedure. * gnu/services.scm (activation-script): Remove call to 'activate-/bin/sh'. (special-files-service-type): New variable. (extra-special-file): New procedure. * gnu/services/base.scm (%base-services): Add SPECIAL-FILES-SERVICE-TYPE instance. * gnu/tests/base.scm (run-basic-test)[special-files]: New variables. ["special files"]: New test. --- doc/guix.texi | 44 ++++++++++++++++++++++++++++++++++++++++++++ gnu/build/activation.scm | 23 ++++++++++++++++++----- gnu/services.scm | 25 +++++++++++++++++++++---- gnu/services/base.scm | 7 ++++++- gnu/tests/base.scm | 17 +++++++++++++++++ 5 files changed, 106 insertions(+), 10 deletions(-) (limited to 'gnu/tests') diff --git a/doc/guix.texi b/doc/guix.texi index 6acde6621b..21082aece4 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -8272,6 +8272,50 @@ this: @end example @end defvr +@defvr {Scheme Variable} special-files-service-type +This is the service that sets up ``special files'' such as +@file{/bin/sh}; an instance of it is part of @code{%base-services}. + +The value associated with @code{special-files-service-type} services +must be a list of tuples where the first element is the ``special file'' +and the second element is its target. By default it is: + +@cindex @file{/bin/sh} +@cindex @file{sh}, in @file{/bin} +@example +`(("/bin/sh" ,(file-append @var{bash} "/bin/sh"))) +@end example + +@cindex @file{/usr/bin/env} +@cindex @file{env}, in @file{/usr/bin} +If you want to add, say, @code{/usr/bin/env} to your system, you can +change it to: + +@example +`(("/bin/sh" ,(file-append @var{bash} "/bin/sh")) + ("/usr/bin/env" ,(file-append @var{coreutils} "/bin/env"))) +@end example + +Since this is part of @code{%base-services}, you can use +@code{modify-services} to customize the set of special files +(@pxref{Service Reference, @code{modify-services}}). But the simple way +to add a special file is @i{via} the @code{extra-special-file} procedure +(see below.) +@end defvr + +@deffn {Scheme Procedure} extra-special-file @var{file} @var{target} +Use @var{target} as the ``special file'' @var{file}. + +For example, adding the following lines to the @code{services} field of +your operating system declaration leads to a @file{/usr/bin/env} +symlink: + +@example +(extra-special-file "/usr/bin/env" + (file-append coreutils "/bin/env")) +@end example +@end deffn + @deffn {Scheme Procedure} host-name-service @var{name} Return a service that sets the host name to @var{name}. @end deffn diff --git a/gnu/build/activation.scm b/gnu/build/activation.scm index e58304e83b..c4ed40e0de 100644 --- a/gnu/build/activation.scm +++ b/gnu/build/activation.scm @@ -28,7 +28,7 @@ (define-module (gnu build activation) activate-user-home activate-etc activate-setuid-programs - activate-/bin/sh + activate-special-files activate-modprobe activate-firmware activate-ptrace-attach @@ -383,10 +383,23 @@ (define (make-setuid-program prog) (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 (activate-special-files special-files) + "Install the files listed in SPECIAL-FILES. Each element of SPECIAL-FILES +is a pair where the first element is the name of the special file and the +second element is the name it should appear at, such as: + + ((\"/bin/sh\" \"/gnu/store/…-bash/bin/sh\") + (\"/usr/bin/env\" \"/gnu/store/…-coreutils/bin/env\")) +" + (define install-special-file + (match-lambda + ((target file) + (let ((pivot (string-append target ".new"))) + (mkdir-p (dirname target)) + (symlink file pivot) + (rename-file pivot target))))) + + (for-each install-special-file special-files)) (define (activate-modprobe modprobe) "Tell the kernel to use MODPROBE to load modules." diff --git a/gnu/services.scm b/gnu/services.scm index e645889d30..6ac4f1322d 100644 --- a/gnu/services.scm +++ b/gnu/services.scm @@ -72,6 +72,8 @@ (define-module (gnu services) activation-service-type activation-service->script %linux-bare-metal-service + special-files-service-type + extra-special-file etc-service-type etc-directory setuid-program-service-type @@ -336,10 +338,6 @@ (define (service-activations) #~(begin (use-modules (gnu build activation)) - ;; Make sure /bin/sh is valid and current. - (activate-/bin/sh - (string-append #$(canonical-package bash) "/bin/sh")) - ;; Make sure the user accounting database exists. If it ;; does not exist, 'setutxent' does not create it and ;; thus there is no accounting at all. @@ -413,6 +411,25 @@ (define %linux-bare-metal-service ;; necessary or impossible in a container. (service linux-bare-metal-service-type #f)) +(define special-files-service-type + ;; Service to install "special files" such as /bin/sh and /usr/bin/env. + (service-type + (name 'special-files) + (extensions + (list (service-extension activation-service-type + (lambda (files) + #~(activate-special-files '#$files))))) + (compose concatenate) + (extend append))) + +(define (extra-special-file file target) + "Use TARGET as the \"special file\" FILE. For example, TARGET might be + (file-append coreutils \"/bin/env\") +and FILE could be \"/usr/bin/env\"." + (simple-service (string->symbol (string-append "special-file-" file)) + special-files-service-type + `((,file ,target)))) + (define (etc-directory service) "Return the directory for SERVICE, a service of type ETC-SERVICE-TYPE." (files->etc-directory (service-parameters service))) diff --git a/gnu/services/base.scm b/gnu/services/base.scm index d9f3a1445e..57601eab85 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -36,6 +36,7 @@ (define-module (gnu services base) #:select (alsa-utils crda eudev e2fsprogs fuse gpm kbd lvm2 rng-tools)) #:use-module ((gnu packages base) #:select (canonical-package glibc)) + #:use-module (gnu packages bash) #:use-module (gnu packages package-management) #:use-module (gnu packages lsof) #:use-module (gnu packages terminals) @@ -1558,6 +1559,10 @@ (define %base-services ;; The LVM2 rules are needed as soon as LVM2 or the device-mapper is ;; used, so enable them by default. The FUSE and ALSA rules are ;; less critical, but handy. - (udev-service #:rules (list lvm2 fuse alsa-utils crda)))) + (udev-service #:rules (list lvm2 fuse alsa-utils crda)) + + (service special-files-service-type + `(("/bin/sh" ,(file-append (canonical-package bash) + "/bin/sh")))))) ;;; base.scm ends here diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm index 8a6a7a1568..000a4ddecb 100644 --- a/gnu/tests/base.scm +++ b/gnu/tests/base.scm @@ -77,6 +77,11 @@ (define* (run-basic-test os command #:optional (name "basic") passed a gexp denoting the marionette, and it must return gexp that is inserted before the first test. This is used to introduce an extra initialization step, such as entering a LUKS passphrase." + (define special-files + (service-parameters + (fold-services (operating-system-services os) + #:target-type special-files-service-type))) + (define test (with-imported-modules '((gnu build marionette) (guix build syscalls)) @@ -120,6 +125,18 @@ (define marionette info --version") marionette))) + (test-equal "special files" + '#$special-files + (marionette-eval + '(begin + (use-modules (ice-9 match)) + + (map (match-lambda + ((file target) + (list file (readlink file)))) + '#$special-files)) + marionette)) + (test-assert "accounts" (let ((users (marionette-eval '(begin (use-modules (ice-9 match)) -- cgit v1.2.3