diff options
| -rw-r--r-- | gnu/system/dmd.scm | 50 | ||||
| -rw-r--r-- | gnu/system/shadow.scm | 23 | ||||
| -rw-r--r-- | gnu/system/vm.scm | 34 |
3 files changed, 62 insertions, 45 deletions
diff --git a/gnu/system/dmd.scm b/gnu/system/dmd.scm index 8a79f0a50f..8e3f7e976a 100644 --- a/gnu/system/dmd.scm +++ b/gnu/system/dmd.scm @@ -24,13 +24,16 @@ #:use-module ((gnu packages base) #:select (glibc-final)) #:use-module ((gnu packages system) - #:select (mingetty inetutils)) + #:select (mingetty inetutils shadow)) #:use-module ((gnu packages package-management) #:select (guix)) #:use-module ((gnu packages linux) #:select (net-tools)) + #:use-module (gnu system shadow) #:use-module (ice-9 match) + #:use-module (ice-9 format) #:use-module (srfi srfi-1) + #:use-module (srfi srfi-26) #:use-module (guix monads) #:export (service? service @@ -40,6 +43,8 @@ service-start service-stop service-inputs + service-user-accounts + service-user-groups host-name-service syslog-service @@ -70,6 +75,10 @@ (stop service-stop ; expression (default #f)) (inputs service-inputs ; list of inputs + (default '())) + (user-accounts service-user-accounts ; list of <user-account> + (default '())) + (user-groups service-user-groups ; list of <user-groups> (default '()))) (define (host-name-service name) @@ -149,16 +158,47 @@ (inputs `(("inetutils" ,inetutils) ("syslog.conf" ,syslog.conf))))))) -(define* (guix-service #:key (guix guix) (builder-group "guixbuild")) - "Return a service that runs the build daemon from GUIX." - (mlet %store-monad ((daemon (package-file guix "bin/guix-daemon"))) +(define* (guix-build-accounts count #:key + (first-uid 30001) + (gid 30000) + (shadow shadow)) + "Return a list of COUNT user accounts for Guix build users, with UIDs +starting at FIRST-UID, and under GID." + (mlet* %store-monad ((gid* -> gid) + (no-login (package-file shadow "sbin/nologin"))) + (return (unfold (cut > <> count) + (lambda (n) + (user-account + (name (format #f "guixbuilder~2,'0d" n)) + (password "!") + (uid (+ first-uid n -1)) + (gid gid*) + (comment (format #f "Guix Build User ~2d" n)) + (home-directory "/var/empty") + (shell no-login))) + 1+ + 1)))) + +(define* (guix-service #:key (guix guix) (builder-group "guixbuild") + (build-user-gid 30000) (build-accounts 10)) + "Return a service that runs the build daemon from GUIX, and has +BUILD-ACCOUNTS user accounts available under BUILD-USER-GID." + (mlet %store-monad ((daemon (package-file guix "bin/guix-daemon")) + (accounts (guix-build-accounts build-accounts + #:gid build-user-gid))) (return (service (provision '(guix-daemon)) (start `(make-forkexec-constructor ,daemon "--build-users-group" ,builder-group)) (stop `(make-kill-destructor)) - (inputs `(("guix" ,guix))))))) + (inputs `(("guix" ,guix))) + (user-accounts accounts) + (user-groups (list (user-group + (name builder-group) + (id build-user-gid) + (members (map user-account-name + user-accounts))))))))) (define* (static-networking-service interface ip #:key diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm index 654fd4d55b..2cc0b89162 100644 --- a/gnu/system/shadow.scm +++ b/gnu/system/shadow.scm @@ -24,9 +24,7 @@ #:use-module ((gnu packages system) #:select (shadow)) #:use-module (srfi srfi-1) - #:use-module (srfi srfi-26) #:use-module (ice-9 match) - #:use-module (ice-9 format) #:export (user-account user-account? user-account-name @@ -117,25 +115,4 @@ file." (text-file (if shadow? "shadow" "passwd") contents)) -(define* (guix-build-accounts count #:key - (first-uid 30001) - (gid 30000) - (shadow shadow)) - "Return a list of COUNT user accounts for Guix build users, with UIDs -starting at FIRST-UID, and under GID." - (mlet* %store-monad ((gid* -> gid) - (no-login (package-file shadow "sbin/nologin"))) - (return (unfold (cut > <> count) - (lambda (n) - (user-account - (name (format #f "guixbuilder~2,'0d" n)) - (password "!") - (uid (+ first-uid n -1)) - (gid gid*) - (comment (format #f "Guix Build User ~2d" n)) - (home-directory "/var/empty") - (shell no-login))) - 1+ - 1)))) - ;;; shadow.scm ends here diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm index 502c13b973..16be5ac59a 100644 --- a/gnu/system/vm.scm +++ b/gnu/system/vm.scm @@ -535,8 +535,6 @@ alias ll='ls -l' (define (system-qemu-image) "Return the derivation of a QEMU image of the GNU system." - (define build-user-gid 30000) - (mlet* %store-monad ((services (listm %store-monad (host-name-service "gnu") @@ -565,8 +563,6 @@ Happy birthday, GNU! http://www.gnu.org/gnu30 #:allow-empty-passwords? #t #:motd motd))) - (build-accounts (guix-build-accounts 10 #:gid build-user-gid)) - (bash-file (package-file bash "bin/bash")) (dmd-file (package-file dmd "bin/dmd")) (dmd-conf (dmd-configuration-file services)) @@ -584,19 +580,23 @@ Happy birthday, GNU! http://www.gnu.org/gnu30 (comment "Guest of GNU") (home-directory "/home/guest") (shell bash-file)) - build-accounts)) - (groups -> (list (user-group - (name "root") - (id 0)) - (user-group - (name "users") - (id 100) - (members '("guest"))) - (user-group - (name "guixbuild") - (id build-user-gid) - (members (map user-account-name - build-accounts))))) + (append-map service-user-accounts + services))) + (groups -> (cons* (user-group + (name "root") + (id 0)) + (user-group + (name "users") + (id 100) + (members '("guest"))) + (append-map service-user-groups services))) + (build-user-gid -> (any (lambda (service) + (and (equal? '(guix-daemon) + (service-provision service)) + (match (service-user-groups service) + ((group) + (user-group-id group))))) + services)) (packages -> `(("coreutils" ,coreutils) ("bash" ,bash) ("guile" ,guile-2.0) |