summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2013-12-07 15:01:40 +0100
committerLudovic Courtès <ludo@gnu.org>2013-12-07 15:01:40 +0100
commit18fb40e414d000b5f342b009a9fbfdc69afb704e (patch)
tree9776d038ebab98ac4f950f2a53cc7c9cbbecbb46
parent25ed6edb6c17e0c7817cb8b29a549b10c8654eba (diff)
gnu: dmd: Add 'user-accounts' and 'user-groups' fields to <service>.
* gnu/system/shadow.scm (guix-build-accounts): Move to... * gnu/system/dmd.scm (guix-build-accounts): ... here. (<service>)[user-accounts, user-groups]: New fields. (guix-service): New #:build-user-id and #:build-accounts parameters. Use 'guix-build-accounts' and set the 'user-accounts' and 'user-groups' fields accordingly. * gnu/system/vm.scm (system-qemu-image): Remove use of 'guix-build-accounts'. Augment ACCOUNTS and GROUPS from what SERVICES demand.
-rw-r--r--gnu/system/dmd.scm50
-rw-r--r--gnu/system/shadow.scm23
-rw-r--r--gnu/system/vm.scm34
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)