diff options
author | Ludovic Courtès <ludo@gnu.org> | 2014-09-03 10:47:05 +0200 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2014-09-03 15:43:07 +0200 |
commit | 548f7a8fa2a4745d0e35e175e201513857440991 (patch) | |
tree | 5fa6118434b77716c93fac9ac2dac51ca257f807 /guix/build/activation.scm | |
parent | 141360b5b257715fdca2db4fc106b4220788ae06 (diff) | |
download | guix-patches-548f7a8fa2a4745d0e35e175e201513857440991.tar guix-patches-548f7a8fa2a4745d0e35e175e201513857440991.tar.gz |
Move operating system helpers from (guix build …) to (gnu build …).
* guix/build/activation.scm, guix/build/install.scm,
guix/build/linux-initrd.scm, guix/build/vm.scm: Move to...
* gnu/build: ... here.
* Makefile.am (MODULES): Remove the above guix/build/ files.
* gnu-system.am (GNU_SYSTEM_MODULES): Add the above gnu/build/ files
here.
* gnu/services/base.scm, gnu/services/dmd.scm, gnu/system.scm,
gnu/system/linux-initrd.scm, gnu/system/vm.scm,
guix/scripts/system.scm: Adjust to the new module names.
Diffstat (limited to 'guix/build/activation.scm')
-rw-r--r-- | guix/build/activation.scm | 226 |
1 files changed, 0 insertions, 226 deletions
diff --git a/guix/build/activation.scm b/guix/build/activation.scm deleted file mode 100644 index b04b017881..0000000000 --- a/guix/build/activation.scm +++ /dev/null @@ -1,226 +0,0 @@ -;;; 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 (guix build activation) - #:use-module (guix build utils) - #:use-module (guix build linux-initrd) - #: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 |