aboutsummaryrefslogtreecommitdiff
path: root/gnu
diff options
context:
space:
mode:
Diffstat (limited to 'gnu')
-rw-r--r--gnu/build/activation.scm39
-rw-r--r--gnu/services/dbus.scm8
-rw-r--r--gnu/tests/base.scm6
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"
'()