futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

gnu: dmd: Add 'user-accounts' and 'user-groups' fields to <service>.

Browse Source 
* 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.
This commit is contained in:
Ludovic Courtès 2013-12-07 15:01:40 +01:00
parent 25ed6edb6c
commit 18fb40e414
3 changed files with 62 additions and 45 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

50
gnu/system/dmd.scm
View File

@ -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

23
gnu/system/shadow.scm
View File

@ -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

34
gnu/system/vm.scm
View File

@ -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)