diff options
Diffstat (limited to 'gnu/build/activation.scm')
| -rw-r--r-- | gnu/build/activation.scm | 226 |
1 files changed, 226 insertions, 0 deletions
diff --git a/gnu/build/activation.scm b/gnu/build/activation.scm new file mode 100644 index 0000000000..bb1165ac47 --- /dev/null +++ b/gnu/build/activation.scm @@ -0,0 +1,226 @@ +;;; GNU Guix --- Functional package management for GNU +;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org> +;;; +;;; This file is part of GNU Guix. +;;; +;;; GNU Guix is free software; you can redistribute it and/or modify it +;;; under the terms of the GNU General Public License as published by +;;; the Free Software Foundation; either version 3 of the License, or (at +;;; your option) any later version. +;;; +;;; GNU Guix is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;;; GNU General Public License for more details. +;;; +;;; You should have received a copy of the GNU General Public License +;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>. + +(define-module (gnu build activation) + #:use-module (gnu build linux-initrd) + #:use-module (guix build utils) + #:use-module (ice-9 ftw) + #:use-module (ice-9 match) + #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) + #:export (activate-users+groups + activate-etc + activate-setuid-programs + activate-current-system)) + +;;; Commentary: +;;; +;;; This module provides "activation" helpers. Activation is the process that +;;; consists in setting up system-wide files and directories so that an +;;; 'operating-system' configuration becomes active. +;;; +;;; Code: + +(define* (add-group name #:key gid password system? + (log-port (current-error-port))) + "Add NAME as a user group, with the given numeric GID if specified." + ;; Use 'groupadd' from the Shadow package. + (format log-port "adding group '~a'...~%" name) + (let ((args `(,@(if gid `("-g" ,(number->string gid)) '()) + ,@(if password `("-p" ,password) '()) + ,@(if system? `("--system") '()) + ,name))) + (zero? (apply system* "groupadd" args)))) + +(define* (add-user name group + #:key uid comment home shell password system? + (supplementary-groups '()) + (log-port (current-error-port))) + "Create an account for user NAME part of GROUP, with the specified +properties. Return #t on success." + (format log-port "adding user '~a'...~%" name) + + (if (and uid (zero? uid)) + + ;; 'useradd' fails with "Cannot determine your user name" if the root + ;; account doesn't exist. Thus, for bootstrapping purposes, create that + ;; one manually. + (begin + (call-with-output-file "/etc/shadow" + (cut format <> "~a::::::::~%" name)) + (call-with-output-file "/etc/passwd" + (cut format <> "~a:x:~a:~a:~a:~a:~a~%" + name "0" "0" comment home shell)) + (chmod "/etc/shadow" #o600) + #t) + + ;; Use 'useradd' from the Shadow package. + (let ((args `(,@(if uid `("-u" ,(number->string uid)) '()) + "-g" ,(if (number? group) (number->string group) group) + ,@(if (pair? supplementary-groups) + `("-G" ,(string-join supplementary-groups ",")) + '()) + ,@(if comment `("-c" ,comment) '()) + ,@(if home + (if (file-exists? home) + `("-d" ,home) ; avoid warning from 'useradd' + `("-d" ,home "--create-home")) + '()) + ,@(if shell `("-s" ,shell) '()) + ,@(if password `("-p" ,password) '()) + ,@(if system? '("--system") '()) + ,name))) + (zero? (apply system* "useradd" args))))) + +(define (activate-users+groups users groups) + "Make sure the accounts listed in USERS and the user groups listed in GROUPS +are all available. + +Each item in USERS is a list of all the characteristics of a user account; +each item in GROUPS is a tuple with the group name, group password or #f, and +numeric gid or #f." + (define (touch file) + (close-port (open-file file "a0b"))) + + (define activate-user + (match-lambda + ((name uid group supplementary-groups comment home shell password system?) + (unless (false-if-exception (getpwnam name)) + (let ((profile-dir (string-append "/var/guix/profiles/per-user/" + name))) + (add-user name group + #:uid uid + #:system? system? + #:supplementary-groups supplementary-groups + #:comment comment + #:home home + #:shell shell + #:password password) + + (unless system? + ;; Create the profile directory for the new account. + (let ((pw (getpwnam name))) + (mkdir-p profile-dir) + (chown profile-dir (passwd:uid pw) (passwd:gid pw))))))))) + + ;; 'groupadd' aborts if the file doesn't already exist. + (touch "/etc/group") + + ;; Create the root account so we can use 'useradd' and 'groupadd'. + (activate-user (find (match-lambda + ((name (? zero?) _ ...) #t) + (_ #f)) + users)) + + ;; Then create the groups. + (for-each (match-lambda + ((name password gid system?) + (unless (false-if-exception (getgrnam name)) + (add-group name + #:gid gid #:password password + #:system? system?)))) + groups) + + ;; Finally create the other user accounts. + (for-each activate-user users)) + +(define (activate-etc etc) + "Install ETC, a directory in the store, as the source of static files for +/etc." + + ;; /etc is a mixture of static and dynamic settings. Here is where we + ;; initialize it from the static part. + + (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"))) + +(define %setuid-directory + ;; Place where setuid programs are stored. + "/run/setuid-programs") + +(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))) + (chown target 0 0) + (chmod target #o6555))) + + (format #t "setting up setuid programs in '~a'...~%" + %setuid-directory) + (if (file-exists? %setuid-directory) + (for-each (compose delete-file + (cut string-append %setuid-directory "/" <>)) + (scandir %setuid-directory + (lambda (file) + (not (member file '("." "..")))) + string<?)) + (mkdir-p %setuid-directory)) + + (for-each make-setuid-program programs)) + +(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 + ;; a new system configuration and activate it, without rebooting. + "/run/current-system") + +(define (boot-time-system) + "Return the '--system' argument passed on the kernel command line." + (find-long-option "--system" (linux-command-line))) + +(define* (activate-current-system #:optional (system (boot-time-system))) + "Atomically make SYSTEM the current system." + (format #t "making '~a' the current system...~%" system) + + ;; Atomically make SYSTEM current. + (let ((new (string-append %current-system ".new"))) + (symlink system new) + (rename-file new %current-system))) + +;;; activation.scm ends here |