From 52322163ac4b730a62af67549583d89ee496aeff Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 31 May 2014 19:16:50 +0200 Subject: system: Add more options for 'mingetty-service'. * gnu/services/base.scm (mingetty-service): Add #:auto-login, #:login-program, and #:login-pause? parameters and honor them. --- gnu/services/base.scm | 37 ++++++++++++++++++++++++++++++++++--- 1 file changed, 34 insertions(+), 3 deletions(-) (limited to 'gnu/services/base.scm') diff --git a/gnu/services/base.scm b/gnu/services/base.scm index dc0161408b..102363819c 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -193,9 +193,31 @@ stopped before 'kill' is called." (define* (mingetty-service tty #:key (motd (text-file "motd" "Welcome.\n")) + auto-login + login-program + login-pause? (allow-empty-passwords? #t)) - "Return a service to run mingetty on TTY." - (mlet %store-monad ((motd motd)) + "Return a service to run mingetty on @var{tty}. + +When @var{allow-empty-passwords?} is true, allow empty log-in password. When +@var{auto-login} is true, it must be a user name under which to log-in +automatically. @var{login-pause?} can be set to @code{#t} in conjunction with +@var{auto-login}, in which case the user will have to press a key before the +login shell is launched. + +When true, @var{login-program} is a gexp or a monadic gexp denoting the name +of the log-in program (the default is the @code{login} program from the Shadow +tool suite.) + +@var{motd} is a monadic value containing a text file to use as +the \"message of the day\"." + (mlet %store-monad ((motd motd) + (login-program (cond ((gexp? login-program) + (return login-program)) + ((not login-program) + (return #f)) + (else + login-program)))) (return (service (documentation (string-append "Run mingetty on " tty ".")) @@ -207,7 +229,16 @@ stopped before 'kill' is called." (start #~(make-forkexec-constructor (string-append #$mingetty "/sbin/mingetty") - "--noclear" #$tty)) + "--noclear" #$tty + #$@(if auto-login + #~("--autologin" #$auto-login) + #~()) + #$@(if login-program + #~("--loginprog" #$login-program) + #~()) + #$@(if login-pause? + #~("--loginpause") + #~()))) (stop #~(make-kill-destructor)) (pam-services -- cgit 1.4.1 From 1f3fc60da529207187fcb0930a06525b6d5b38c9 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sun, 1 Jun 2014 23:51:59 +0200 Subject: services: syslogd: Write fewer messages to /dev/console. * gnu/services/base.scm (syslog-service)[contents]: Remove "kern.*" from /dev/console. --- gnu/services/base.scm | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'gnu/services/base.scm') diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 102363819c..3643f7cfc1 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -274,11 +274,11 @@ the \"message of the day\"." ;; Snippet adapted from the GNU inetutils manual. (define contents " - # Log all kernel messages, authentication messages of + # Log all error messages, authentication messages of # level notice or higher and anything of level err or # higher to the console. # Don't log private authentication messages! - *.err;kern.*;auth.notice;authpriv.none /dev/console + *.err;auth.notice;authpriv.none /dev/console # Log anything (except mail) of level info or higher. # Don't log private authentication messages! -- cgit 1.4.1 From d4c87617e5c0c50573019e4621ed318489cf209a Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 2 Jun 2014 23:58:50 +0200 Subject: system: File system sources can be marked as labels or devices. * gnu/system/file-systems.scm ()[title]: New field. * gnu/services/base.scm (file-system-service): Add #:title parameter. In 'start' gexp, use 'canonicalize-device-spec' and honor TITLE. * gnu/system.scm (other-file-system-services, operating-system-root-file-system, operating-system-initrd-file): Adjust accordingly. * gnu/system/linux-initrd.scm (file-system->spec): Likewise. * gnu/system/vm.scm (system-disk-image): Add 'title' field for the root file system. * guix/build/linux-initrd.scm (mount-file-system): Expect the second element of SPEC to be the title. (boot-system)[root-mount-point?, root-fs-type]: Likewise. * gnu/services/dmd.scm (dmd-configuration-file): Select 'canonicalize-device-spec'. --- gnu/services/base.scm | 15 +++++++++------ gnu/services/dmd.scm | 2 +- gnu/system.scm | 11 +++++++---- gnu/system/file-systems.scm | 3 +++ gnu/system/linux-initrd.scm | 4 ++-- gnu/system/vm.scm | 1 + guix/build/linux-initrd.scm | 11 ++++++----- 7 files changed, 29 insertions(+), 18 deletions(-) (limited to 'gnu/services/base.scm') diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 3643f7cfc1..4442203524 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -89,9 +89,11 @@ This service must be the root of the service dependency graph so that its (respawn? #f))))) (define* (file-system-service device target type - #:key (check? #t) options) + #:key (check? #t) options (title 'any)) "Return a service that mounts DEVICE on TARGET as a file system TYPE with -OPTIONS. When CHECK? is true, check the file system before mounting it." +OPTIONS. TITLE is a symbol specifying what kind of name DEVICE is: 'label for +a partition label, 'device for a device file name, or 'any. When CHECK? is +true, check the file system before mounting it." (with-monad %store-monad (return (service @@ -99,10 +101,11 @@ OPTIONS. When CHECK? is true, check the file system before mounting it." (requirement '(root-file-system)) (documentation "Check, mount, and unmount the given file system.") (start #~(lambda args - #$(if check? - #~(check-file-system #$device #$type) - #~#t) - (mount #$device #$target #$type 0 #$options) + (let ((device (canonicalize-device-spec #$device '#$title))) + #$(if check? + #~(check-file-system device #$type) + #~#t) + (mount device #$target #$type 0 #$options)) #t)) (stop #~(lambda args ;; Normally there are no processes left at this point, so diff --git a/gnu/services/dmd.scm b/gnu/services/dmd.scm index 982c196fe4..74adb27885 100644 --- a/gnu/services/dmd.scm +++ b/gnu/services/dmd.scm @@ -50,7 +50,7 @@ (use-modules (ice-9 ftw) (guix build syscalls) ((guix build linux-initrd) - #:select (check-file-system))) + #:select (check-file-system canonicalize-device-spec))) (register-services #$@(map (lambda (service) diff --git a/gnu/system.scm b/gnu/system.scm index d05ec60b29..548184f5d5 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -182,8 +182,10 @@ as 'needed-for-boot'." (sequence %store-monad (map (match-lambda - (($ device target type flags opts #f check?) + (($ device title target type flags opts + #f check?) (file-system-service device target type + #:title title #:check? check? #:options opts))) file-systems))) @@ -449,7 +451,7 @@ we're running in the final root." (define (operating-system-root-file-system os) "Return the root file system of OS." (find (match-lambda - (($ _ "/") #t) + (($ _ _ "/") #t) (_ #f)) (operating-system-file-systems os))) @@ -457,9 +459,10 @@ we're running in the final root." "Return a gexp denoting the initrd file of OS." (define boot-file-systems (filter (match-lambda - (($ device "/") + (($ device title "/") #t) - (($ device mount-point type flags options boot?) + (($ device title mount-point type flags + options boot?) boot?)) (operating-system-file-systems os))) diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm index 485150ea51..7852a6ab26 100644 --- a/gnu/system/file-systems.scm +++ b/gnu/system/file-systems.scm @@ -22,6 +22,7 @@ file-system file-system? file-system-device + file-system-title file-system-mount-point file-system-type file-system-needed-for-boot? @@ -42,6 +43,8 @@ make-file-system file-system? (device file-system-device) ; string + (title file-system-title ; 'device | 'label | 'uuid + (default 'device)) (mount-point file-system-mount-point) ; string (type file-system-type) ; string (flags file-system-flags ; list of symbols diff --git a/gnu/system/linux-initrd.scm b/gnu/system/linux-initrd.scm index b80ff10f1e..17fec4f7f4 100644 --- a/gnu/system/linux-initrd.scm +++ b/gnu/system/linux-initrd.scm @@ -198,8 +198,8 @@ a list of Guile module names to be embedded in the initrd." "Return a list corresponding to file-system FS that can be passed to the initrd code." (match fs - (($ device mount-point type flags options _ check?) - (list device mount-point type flags options check?)))) + (($ device title mount-point type flags options _ check?) + (list device title mount-point type flags options check?)))) (define* (qemu-initrd file-systems #:key diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 184f2512f1..c85445cd5f 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -290,6 +290,7 @@ to USB sticks meant to be read-only." (file-systems (cons (file-system (mount-point "/") (device root-label) + (title 'label) (type file-system-type)) file-systems-to-keep))))) diff --git a/guix/build/linux-initrd.scm b/guix/build/linux-initrd.scm index 05f6bf14bf..c1a0247aff 100644 --- a/guix/build/linux-initrd.scm +++ b/guix/build/linux-initrd.scm @@ -37,6 +37,7 @@ disk-partitions partition-label-predicate find-partition-by-label + canonicalize-device-spec check-file-system mount-file-system @@ -485,7 +486,7 @@ UNIONFS." "Mount the file system described by SPEC under ROOT. SPEC must have the form: - (DEVICE MOUNT-POINT TYPE (FLAGS ...) OPTIONS CHECK?) + (DEVICE TITLE MOUNT-POINT TYPE (FLAGS ...) OPTIONS CHECK?) DEVICE, MOUNT-POINT, and TYPE must be strings; OPTIONS can be a string or #f; FLAGS must be a list of symbols. CHECK? is a Boolean indicating whether to @@ -500,8 +501,8 @@ run a file system check." 0))) (match spec - ((source mount-point type (flags ...) options check?) - (let ((source (canonicalize-device-spec source)) + ((source title mount-point type (flags ...) options check?) + (let ((source (canonicalize-device-spec source title)) (mount-point (string-append root "/" mount-point))) (when check? (check-file-system source type)) @@ -596,12 +597,12 @@ to it are lost." (define root-mount-point? (match-lambda - ((device "/" _ ...) #t) + ((device _ "/" _ ...) #t) (_ #f))) (define root-fs-type (or (any (match-lambda - ((device "/" type _ ...) type) + ((device _ "/" type _ ...) type) (_ #f)) mounts) "ext4")) -- cgit 1.4.1 From 2c5c696c39b2d80b1e1b1f477822a6711d779b71 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 4 Jun 2014 16:07:09 +0200 Subject: install: Register the hydra.gnu.org key on the installation image. * gnu/services/base.scm (hydra-key-authorization): New procedure. (guix-service): Add #:authorize-hydra-key? parameter; honor it using 'hydra-key-authorization'. * gnu/system/install.scm (installation-services): Pass #:authorize-hydra-key? #t. --- gnu/services/base.scm | 35 ++++++++++++++++++++++++++++++++--- gnu/system/install.scm | 7 ++++++- 2 files changed, 38 insertions(+), 4 deletions(-) (limited to 'gnu/services/base.scm') diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 4442203524..463185d53c 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -330,10 +330,37 @@ starting at FIRST-UID, and under GID." 1+ 1)))) +(define (hydra-key-authorization guix) + "Return a gexp with code to register the hydra.gnu.org public key with +GUIX." + #~(unless (file-exists? "/etc/guix/acl") + (let ((pid (primitive-fork))) + (case pid + ((0) + (let* ((key (string-append #$guix + "/share/guix/hydra.gnu.org.pub")) + (port (open-file key "r0b"))) + (format #t "registering public key '~a'...~%" key) + (close-port (current-input-port)) + ;; (close-fdes 0) + (dup port 0) + (execl (string-append #$guix "/bin/guix") + "guix" "archive" "--authorize") + (exit 1))) + (else + (let ((status (cdr (waitpid pid)))) + (unless (zero? status) + (format (current-error-port) "warning: \ +failed to register hydra.gnu.org public key: ~a~%" status)))))))) + (define* (guix-service #:key (guix guix) (builder-group "guixbuild") - (build-accounts 10)) + (build-accounts 10) authorize-hydra-key?) "Return a service that runs the build daemon from GUIX, and has -BUILD-ACCOUNTS user accounts available under BUILD-USER-GID." +BUILD-ACCOUNTS user accounts available under BUILD-USER-GID. + +When AUTHORIZE-HYDRA-KEY? is true, the hydra.gnu.org public key provided by +GUIX is authorized upon activation, meaning that substitutes from +hydra.gnu.org are used by default." (mlet %store-monad ((accounts (guix-build-accounts build-accounts #:group builder-group))) (return (service @@ -349,7 +376,9 @@ BUILD-ACCOUNTS user accounts available under BUILD-USER-GID." (user-groups (list (user-group (name builder-group) (members (map user-account-name - user-accounts))))))))) + user-accounts))))) + (activate (and authorize-hydra-key? + (hydra-key-authorization guix))))))) (define %base-services ;; Convenience variable holding the basic services. diff --git a/gnu/system/install.scm b/gnu/system/install.scm index c69e51b2b5..707f6b6c86 100644 --- a/gnu/system/install.scm +++ b/gnu/system/install.scm @@ -77,7 +77,12 @@ You have been warned. Thanks for being so brave. ;; The usual services. (syslog-service) - (guix-service) + + ;; The build daemon. Register the hydra.gnu.org key as trusted. + ;; This allows the installation process to use substitutes by + ;; default. + (guix-service #:authorize-hydra-key? #t) + (nscd-service)))) (define %issue -- cgit 1.4.1 From 3d116a70f9b18027b31be2e11e8c9c9192622607 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 4 Jun 2014 22:17:20 +0200 Subject: services: Add the build group to the supplementary groups of build users. * gnu/services/base.scm (guix-build-accounts): Add 'supplementary-groups' field. --- gnu/services/base.scm | 6 ++++++ 1 file changed, 6 insertions(+) (limited to 'gnu/services/base.scm') diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 463185d53c..3f7f453c9b 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -324,6 +324,12 @@ starting at FIRST-UID, and under GID." (name (format #f "guixbuilder~2,'0d" n)) (uid (+ first-uid n -1)) (group group) + + ;; guix-daemon expects GROUP to be listed as a + ;; supplementary group too: + ;; . + (supplementary-groups (list group)) + (comment (format #f "Guix Build User ~2d" n)) (home-directory "/var/empty") (shell #~(string-append #$shadow "/sbin/nologin")))) -- cgit 1.4.1 From 185f669109eb56b61c3d51dc8b2e3eeded9b2be9 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Wed, 4 Jun 2014 22:19:30 +0200 Subject: services: Make sure the store's group is the build group. * gnu/services/base.scm (guix-service)[activate]: New variable. Add 'chown' call for (%store-prefix). Set the 'activate' field to ACTIVATE. * guix/build/install.scm (directives): Add comment about STORE's group. --- gnu/services/base.scm | 18 +++++++++++++++--- guix/build/install.scm | 5 ++++- 2 files changed, 19 insertions(+), 4 deletions(-) (limited to 'gnu/services/base.scm') diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 3f7f453c9b..94fa919c0f 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -17,6 +17,8 @@ ;;; along with GNU Guix. If not, see . (define-module (gnu services base) + #:use-module ((guix store) + #:select (%store-prefix)) #:use-module (gnu services) #:use-module (gnu system shadow) ; 'user-account', etc. #:use-module (gnu system linux) ; 'pam-service', etc. @@ -348,7 +350,6 @@ GUIX." (port (open-file key "r0b"))) (format #t "registering public key '~a'...~%" key) (close-port (current-input-port)) - ;; (close-fdes 0) (dup port 0) (execl (string-append #$guix "/bin/guix") "guix" "archive" "--authorize") @@ -367,6 +368,18 @@ BUILD-ACCOUNTS user accounts available under BUILD-USER-GID. When AUTHORIZE-HYDRA-KEY? is true, the hydra.gnu.org public key provided by GUIX is authorized upon activation, meaning that substitutes from hydra.gnu.org are used by default." + (define activate + #~(begin + ;; Make sure the store has BUILDER-GROUP as its group. This may fail + ;; with EACCES when the store is a 9p mount, so catch exceptions. + (false-if-exception + (chown #$(%store-prefix) 0 + (group:gid (getgrnam #$builder-group)))) + + ;; Optionally authorize hydra.gnu.org's key. + #$(and authorize-hydra-key? + (hydra-key-authorization guix)))) + (mlet %store-monad ((accounts (guix-build-accounts build-accounts #:group builder-group))) (return (service @@ -383,8 +396,7 @@ hydra.gnu.org are used by default." (name builder-group) (members (map user-account-name user-accounts))))) - (activate (and authorize-hydra-key? - (hydra-key-authorization guix))))))) + (activate activate))))) (define %base-services ;; Convenience variable holding the basic services. diff --git a/guix/build/install.scm b/guix/build/install.scm index afa7d1dd8f..ea787b63e2 100644 --- a/guix/build/install.scm +++ b/guix/build/install.scm @@ -73,7 +73,10 @@ directory TARGET." (define (directives store) "Return a list of directives to populate the root file system that will host STORE." - `((directory ,store 0 0) + `(;; Note: The store's group is changed to the "guixbuild" group at + ;; activation time. + (directory ,store 0 0) + (directory "/etc") (directory "/var/log") ; for dmd (directory "/var/guix/gcroots") -- cgit 1.4.1 From e97c5be914864674d024dd088eb1f2788ac49f46 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 6 Jun 2014 00:09:12 +0200 Subject: services: Use a fixed GID for the build group and use that for the store. This partly reverts commit 185f669 ("services: Make sure the store's group is the build group.") * gnu/services/base.scm (guix-service)[activate]: Remove 'chown' call. Add 'id' field to 'user-group' form. * guix/build/install.scm (directives): Set the store's GID to 30000. --- gnu/services/base.scm | 21 +++++++++++---------- guix/build/install.scm | 6 +++--- 2 files changed, 14 insertions(+), 13 deletions(-) (limited to 'gnu/services/base.scm') diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 94fa919c0f..65a8ceefc4 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -369,16 +369,13 @@ When AUTHORIZE-HYDRA-KEY? is true, the hydra.gnu.org public key provided by GUIX is authorized upon activation, meaning that substitutes from hydra.gnu.org are used by default." (define activate - #~(begin - ;; Make sure the store has BUILDER-GROUP as its group. This may fail - ;; with EACCES when the store is a 9p mount, so catch exceptions. - (false-if-exception - (chown #$(%store-prefix) 0 - (group:gid (getgrnam #$builder-group)))) + ;; Assume that the store has BUILDER-GROUP as its group. We could + ;; otherwise call 'chown' here, but the problem is that on a COW unionfs, + ;; chown leads to an entire copy of the tree, which is a bad idea. - ;; Optionally authorize hydra.gnu.org's key. - #$(and authorize-hydra-key? - (hydra-key-authorization guix)))) + ;; Optionally authorize hydra.gnu.org's key. + (and authorize-hydra-key? + (hydra-key-authorization guix))) (mlet %store-monad ((accounts (guix-build-accounts build-accounts #:group builder-group))) @@ -395,7 +392,11 @@ hydra.gnu.org are used by default." (user-groups (list (user-group (name builder-group) (members (map user-account-name - user-accounts))))) + user-accounts)) + + ;; Use a fixed GID so that we can create the + ;; store with the right owner. + (id 30000)))) (activate activate))))) (define %base-services diff --git a/guix/build/install.scm b/guix/build/install.scm index ea787b63e2..2a76394faa 100644 --- a/guix/build/install.scm +++ b/guix/build/install.scm @@ -73,9 +73,9 @@ directory TARGET." (define (directives store) "Return a list of directives to populate the root file system that will host STORE." - `(;; Note: The store's group is changed to the "guixbuild" group at - ;; activation time. - (directory ,store 0 0) + `(;; Note: the store's GID is fixed precisely so we can set it here rather + ;; than at activation time. + (directory ,store 0 30000) (directory "/etc") (directory "/var/log") ; for dmd -- cgit 1.4.1