aboutsummaryrefslogtreecommitdiff
path: root/gnu/build/activation.scm
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/build/activation.scm')
-rw-r--r--gnu/build/activation.scm226
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