;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
;;;
;;; This file is part of GNU Guix.
#:use-module (gnu build accounts)
#:use-module (gnu build linux-boot)
#:use-module (guix build utils)
+ #:use-module ((guix build syscalls) #:select (with-file-lock))
#: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)
(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."
(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")
- (let-values (((groups passwd shadow)
- (user+group-databases users groups)))
- (write-group groups)
- (write-passwd passwd)
- (write-shadow shadow)
-
- ;; 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))))
+ ;; Take same lock as libc's 'lckpwdf' (but without a timeout) while we read
+ ;; and write the databases. This ensures there's no race condition with
+ ;; other tools that might be accessing it at the same time.
+ (with-file-lock %password-lock-file
+ (let-values (((groups passwd shadow)
+ (user+group-databases users groups)))
+ (write-group groups)
+ (write-passwd passwd)
+ (write-shadow shadow)))
+
+ ;; Home directories of non-system accounts are created by
+ ;; 'activate-user-home'.
+ (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
string<?))
(mkdir-p %setuid-directory))
- (for-each make-setuid-program programs))
+ (for-each (lambda (program)
+ (catch 'system-error
+ (lambda ()
+ (make-setuid-program program))
+ (lambda args
+ ;; If we fail to create a setuid program, better keep going
+ ;; so that we don't leave %SETUID-DIRECTORY empty or
+ ;; half-populated. This can happen if PROGRAMS contains
+ ;; incorrect file names: <https://bugs.gnu.org/38800>.
+ (format (current-error-port)
+ "warning: failed to make '~a' setuid-root: ~a~%"
+ program (strerror (system-error-errno args))))))
+ programs))
(define (activate-special-files special-files)
"Install the files listed in SPECIAL-FILES. Each element of SPECIAL-FILES
(define (activate-modprobe modprobe)
"Tell the kernel to use MODPROBE to load modules."
- (call-with-output-file "/proc/sys/kernel/modprobe"
- (lambda (port)
- (display modprobe port))))
+
+ ;; If the kernel was built without loadable module support, this file is
+ ;; unavailable, so check for its existence first.
+ (when (file-exists? "/proc/sys/kernel/modprobe")
+ (call-with-output-file "/proc/sys/kernel/modprobe"
+ (lambda (port)
+ (display modprobe port)))))
(define (activate-firmware directory)
"Tell the kernel to look for device firmware under DIRECTORY. This
(define (boot-time-system)
"Return the '--system' argument passed on the kernel command line."
- (find-long-option "--system" (linux-command-line)))
+ (find-long-option "--system" (if (string-contains %host-type "linux-gnu")
+ (linux-command-line)
+ (command-line))))
(define* (activate-current-system
#:optional (system (or (getenv "GUIX_NEW_SYSTEM")