gnu/build/activation.scm

   1 ;;; GNU Guix --- Functional package management for GNU
   2 ;;; Copyright © 2013, 2014 Ludovic Courtès <ludo@gnu.org>
   3 ;;;
   4 ;;; This file is part of GNU Guix.
   5 ;;;
   6 ;;; GNU Guix is free software; you can redistribute it and/or modify it
   7 ;;; under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 3 of the License, or (at
   9 ;;; your option) any later version.
  10 ;;;
  11 ;;; GNU Guix is distributed in the hope that it will be useful, but
  12 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
  13 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14 ;;; GNU General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU General Public License
  17 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
  18
  19 (define-module (gnu build activation)
  20   #:use-module (gnu build linux-initrd)
  21   #:use-module (guix build utils)
  22   #:use-module (ice-9 ftw)
  23   #:use-module (ice-9 match)
  24   #:use-module (srfi srfi-1)
  25   #:use-module (srfi srfi-26)
  26   #:export (activate-users+groups
  27             activate-etc
  28             activate-setuid-programs
  29             activate-current-system))
  30
  31 ;;; Commentary:
  32 ;;;
  33 ;;; This module provides "activation" helpers.  Activation is the process that
  34 ;;; consists in setting up system-wide files and directories so that an
  35 ;;; 'operating-system' configuration becomes active.
  36 ;;;
  37 ;;; Code:
  38
  39 (define* (add-group name #:key gid password system?
  40                     (log-port (current-error-port)))
  41   "Add NAME as a user group, with the given numeric GID if specified."
  42   ;; Use 'groupadd' from the Shadow package.
  43   (format log-port "adding group '~a'...~%" name)
  44   (let ((args `(,@(if gid `("-g" ,(number->string gid)) '())
  45                 ,@(if password `("-p" ,password) '())
  46                 ,@(if system? `("--system") '())
  47                 ,name)))
  48     (zero? (apply system* "groupadd" args))))
  49
  50 (define* (add-user name group
  51                    #:key uid comment home shell password system?
  52                    (supplementary-groups '())
  53                    (log-port (current-error-port)))
  54   "Create an account for user NAME part of GROUP, with the specified
  55 properties.  Return #t on success."
  56   (format log-port "adding user '~a'...~%" name)
  57
  58   (if (and uid (zero? uid))
  59
  60       ;; 'useradd' fails with "Cannot determine your user name" if the root
  61       ;; account doesn't exist.  Thus, for bootstrapping purposes, create that
  62       ;; one manually.
  63       (begin
  64         (call-with-output-file "/etc/shadow"
  65           (cut format <> "~a::::::::~%" name))
  66         (call-with-output-file "/etc/passwd"
  67           (cut format <> "~a:x:~a:~a:~a:~a:~a~%"
  68                name "0" "0" comment home shell))
  69         (chmod "/etc/shadow" #o600)
  70         #t)
  71
  72       ;; Use 'useradd' from the Shadow package.
  73       (let ((args `(,@(if uid `("-u" ,(number->string uid)) '())
  74                     "-g" ,(if (number? group) (number->string group) group)
  75                     ,@(if (pair? supplementary-groups)
  76                           `("-G" ,(string-join supplementary-groups ","))
  77                           '())
  78                     ,@(if comment `("-c" ,comment) '())
  79                     ,@(if home
  80                           (if (file-exists? home)
  81                               `("-d" ,home)     ; avoid warning from 'useradd'
  82                               `("-d" ,home "--create-home"))
  83                           '())
  84                     ,@(if shell `("-s" ,shell) '())
  85                     ,@(if password `("-p" ,password) '())
  86                     ,@(if system? '("--system") '())
  87                     ,name)))
  88         (zero? (apply system* "useradd" args)))))
  89
  90 (define (activate-users+groups users groups)
  91   "Make sure the accounts listed in USERS and the user groups listed in GROUPS
  92 are all available.
  93
  94 Each item in USERS is a list of all the characteristics of a user account;
  95 each item in GROUPS is a tuple with the group name, group password or #f, and
  96 numeric gid or #f."
  97   (define (touch file)
  98     (close-port (open-file file "a0b")))
  99
 100   (define activate-user
 101     (match-lambda
 102      ((name uid group supplementary-groups comment home shell password system?)
 103       (unless (false-if-exception (getpwnam name))
 104         (let ((profile-dir (string-append "/var/guix/profiles/per-user/"
 105                                           name)))
 106           (add-user name group
 107                     #:uid uid
 108                     #:system? system?
 109                     #:supplementary-groups supplementary-groups
 110                     #:comment comment
 111                     #:home home
 112                     #:shell shell
 113                     #:password password)
 114
 115           (unless system?
 116             ;; Create the profile directory for the new account.
 117             (let ((pw (getpwnam name)))
 118               (mkdir-p profile-dir)
 119               (chown profile-dir (passwd:uid pw) (passwd:gid pw)))))))))
 120
 121   ;; 'groupadd' aborts if the file doesn't already exist.
 122   (touch "/etc/group")
 123
 124   ;; Create the root account so we can use 'useradd' and 'groupadd'.
 125   (activate-user (find (match-lambda
 126                         ((name (? zero?) _ ...) #t)
 127                         (_ #f))
 128                        users))
 129
 130   ;; Then create the groups.
 131   (for-each (match-lambda
 132              ((name password gid system?)
 133               (unless (false-if-exception (getgrnam name))
 134                 (add-group name
 135                            #:gid gid #:password password
 136                            #:system? system?))))
 137             groups)
 138
 139   ;; Finally create the other user accounts.
 140   (for-each activate-user users))
 141
 142 (define (activate-etc etc)
 143   "Install ETC, a directory in the store, as the source of static files for
 144 /etc."
 145
 146   ;; /etc is a mixture of static and dynamic settings.  Here is where we
 147   ;; initialize it from the static part.
 148
 149   (format #t "populating /etc from ~a...~%" etc)
 150   (let ((rm-f (lambda (f)
 151                 (false-if-exception (delete-file f)))))
 152     (rm-f "/etc/static")
 153     (symlink etc "/etc/static")
 154     (for-each (lambda (file)
 155                 ;; TODO: Handle 'shadow' specially so that changed
 156                 ;; password aren't lost.
 157                 (let ((target (string-append "/etc/" file))
 158                       (source (string-append "/etc/static/" file)))
 159                   (rm-f target)
 160                   (symlink source target)))
 161               (scandir etc
 162                        (lambda (file)
 163                          (not (member file '("." ".."))))
 164
 165                        ;; The default is 'string-locale<?', but we don't have
 166                        ;; it when run from the initrd's statically-linked
 167                        ;; Guile.
 168                        string<?))
 169
 170     ;; Prevent ETC from being GC'd.
 171     (rm-f "/var/guix/gcroots/etc-directory")
 172     (symlink etc "/var/guix/gcroots/etc-directory")))
 173
 174 (define %setuid-directory
 175   ;; Place where setuid programs are stored.
 176   "/run/setuid-programs")
 177
 178 (define (activate-setuid-programs programs)
 179   "Turn PROGRAMS, a list of file names, into setuid programs stored under
 180 %SETUID-DIRECTORY."
 181   (define (make-setuid-program prog)
 182     (let ((target (string-append %setuid-directory
 183                                  "/" (basename prog))))
 184       (catch 'system-error
 185         (lambda ()
 186           (link prog target))
 187         (lambda args
 188           ;; Perhaps PROG and TARGET live in a different file system, so copy
 189           ;; PROG.
 190           (copy-file prog target)))
 191       (chown target 0 0)
 192       (chmod target #o6555)))
 193
 194   (format #t "setting up setuid programs in '~a'...~%"
 195           %setuid-directory)
 196   (if (file-exists? %setuid-directory)
 197       (for-each (compose delete-file
 198                          (cut string-append %setuid-directory "/" <>))
 199                 (scandir %setuid-directory
 200                          (lambda (file)
 201                            (not (member file '("." ".."))))
 202                          string<?))
 203       (mkdir-p %setuid-directory))
 204
 205   (for-each make-setuid-program programs))
 206
 207 (define %current-system
 208   ;; The system that is current (a symlink.)  This is not necessarily the same
 209   ;; as the system we booted (aka. /run/booted-system) because we can re-build
 210   ;; a new system configuration and activate it, without rebooting.
 211   "/run/current-system")
 212
 213 (define (boot-time-system)
 214   "Return the '--system' argument passed on the kernel command line."
 215   (find-long-option "--system" (linux-command-line)))
 216
 217 (define* (activate-current-system #:optional (system (boot-time-system)))
 218   "Atomically make SYSTEM the current system."
 219   (format #t "making '~a' the current system...~%" system)
 220
 221   ;; Atomically make SYSTEM current.
 222   (let ((new (string-append %current-system ".new")))
 223     (symlink system new)
 224     (rename-file new %current-system)))
 225
 226 ;;; activation.scm ends here