diff options
| -rw-r--r-- | gnu/build/activation.scm | 39 | ||||
| -rw-r--r-- | gnu/services/dbus.scm | 8 | ||||
| -rw-r--r-- | gnu/tests/base.scm | 6 |
3 files changed, 46 insertions, 7 deletions
diff --git a/gnu/build/activation.scm b/gnu/build/activation.scm index f24e6029fa..cfdf17df0f 100644 --- a/gnu/build/activation.scm +++ b/gnu/build/activation.scm @@ -24,6 +24,7 @@ #:use-module (guix build utils) #:use-module (ice-9 ftw) #:use-module (ice-9 match) + #:use-module (ice-9 vlist) #:use-module (srfi srfi-1) #:use-module (srfi srfi-11) #:use-module (srfi srfi-26) @@ -90,6 +91,21 @@ owner-writable in HOME." (make-file-writable target)))) files))) +(define (duplicates lst) + "Return elements from LST present more than once in LST." + (let loop ((lst lst) + (seen vlist-null) + (result '())) + (match lst + (() + (reverse result)) + ((head . tail) + (loop tail + (vhash-cons head #t seen) + (if (vhash-assoc head seen) + (cons head result) + result)))))) + (define (activate-users+groups users groups) "Make sure USERS (a list of user account records) and GROUPS (a list of user group records) are all available." @@ -97,9 +113,19 @@ group records) are all available." (let ((home (user-account-home-directory user)) (pwd (getpwnam (user-account-name user)))) (mkdir-p home) + + ;; Always set ownership and permissions for home directories of system + ;; accounts. If a service needs looser permissions on its home + ;; directories, it can always chmod it in an activation snippet. (chown home (passwd:uid pwd) (passwd:gid pwd)) (chmod home #o700))) + (define system-accounts + (filter (lambda (user) + (and (user-account-system? user) + (user-account-create-home-directory? user))) + users)) + ;; Allow home directories to be created under /var/lib. (mkdir-p "/var/lib") @@ -111,11 +137,14 @@ group records) are all available." ;; Home directories of non-system accounts are created by ;; 'activate-user-home'. - (for-each make-home-directory - (filter (lambda (user) - (and (user-account-system? user) - (user-account-create-home-directory? user))) - users)))) + (for-each make-home-directory system-accounts) + + ;; Turn shared home directories, such as /var/empty, into root-owned, + ;; read-only places. + (for-each (lambda (directory) + (chown directory 0 0) + (chmod directory #o555)) + (duplicates (map user-account-home-directory system-accounts))))) (define (activate-user-home users) "Create and populate the home directory of USERS, a list of tuples, unless diff --git a/gnu/services/dbus.scm b/gnu/services/dbus.scm index 1e24d93ccb..606ee0c2f5 100644 --- a/gnu/services/dbus.scm +++ b/gnu/services/dbus.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2013, 2014, 2015, 2016, 2017 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2015 Sou Bunnbu <iyzsong@gmail.com> ;;; ;;; This file is part of GNU Guix. @@ -150,7 +150,11 @@ includes the @code{etc/dbus-1/system.d} directories of each package listed in (let ((user (getpwnam "messagebus"))) (chown "/var/run/dbus" - (passwd:uid user) (passwd:gid user))) + (passwd:uid user) (passwd:gid user)) + + ;; This directory contains the daemon's socket so it must be + ;; world-readable. + (chmod "/var/run/dbus" #o755)) (unless (file-exists? "/etc/machine-id") (format #t "creating /etc/machine-id...~%") diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm index cc8b273c98..f9390ee8e4 100644 --- a/gnu/tests/base.scm +++ b/gnu/tests/base.scm @@ -258,6 +258,12 @@ info --version") (operating-system-user-accounts os)))) (stat:perms (marionette-eval `(stat ,root-home) marionette)))) + (test-equal "ownership and permissions of /var/empty" + '(0 0 #o555) + (let ((st (marionette-eval `(stat "/var/empty") marionette))) + (list (stat:uid st) (stat:gid st) + (stat:perms st)))) + (test-equal "no extra home directories" '() |