ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 21:38:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

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 @@ (define-module (gnu system dmd)
#:use-module ((gnu packages base) #:use-module ((gnu packages base)
#:select (glibc-final)) #:select (glibc-final))
#:use-module ((gnu packages system) #:use-module ((gnu packages system)
#:select (mingetty inetutils)) #:select (mingetty inetutils shadow))
#:use-module ((gnu packages package-management) #:use-module ((gnu packages package-management)
#:select (guix)) #:select (guix))
#:use-module ((gnu packages linux) #:use-module ((gnu packages linux)
#:select (net-tools)) #:select (net-tools))
#:use-module (gnu system shadow)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 format)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (guix monads) #:use-module (guix monads)
#:export (service? #:export (service?
service service
@ -40,6 +43,8 @@ (define-module (gnu system dmd)
service-start service-start
service-stop service-stop
service-inputs service-inputs
service-user-accounts
service-user-groups
host-name-service host-name-service
syslog-service syslog-service
@ -70,6 +75,10 @@ (define-record-type* <service>
(stop service-stop ; expression (stop service-stop ; expression
(default #f)) (default #f))
(inputs service-inputs ; list of inputs (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 '()))) (default '())))
(define (host-name-service name) (define (host-name-service name)
@ -149,16 +158,47 @@ (define contents "
(inputs `(("inetutils" ,inetutils) (inputs `(("inetutils" ,inetutils)
("syslog.conf" ,syslog.conf))))))) ("syslog.conf" ,syslog.conf)))))))
(define* (guix-service #:key (guix guix) (builder-group "guixbuild")) (define* (guix-build-accounts count #:key
"Return a service that runs the build daemon from GUIX." (first-uid 30001)
(mlet %store-monad ((daemon (package-file guix "bin/guix-daemon"))) (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 (return (service
(provision '(guix-daemon)) (provision '(guix-daemon))
(start `(make-forkexec-constructor ,daemon (start `(make-forkexec-constructor ,daemon
"--build-users-group" "--build-users-group"
,builder-group)) ,builder-group))
(stop `(make-kill-destructor)) (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 (define* (static-networking-service interface ip
#:key #:key

23
gnu/system/shadow.scm
View file

@ -24,9 +24,7 @@ (define-module (gnu system shadow)
#:use-module ((gnu packages system) #:use-module ((gnu packages system)
#:select (shadow)) #:select (shadow))
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 format)
#:export (user-account #:export (user-account
user-account? user-account?
user-account-name user-account-name
@ -117,25 +115,4 @@ (define contents
(text-file (if shadow? "shadow" "passwd") contents)) (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 ;;; shadow.scm ends here

34
gnu/system/vm.scm
View file

@ -535,8 +535,6 @@ (define* (etc-directory #:key
(define (system-qemu-image) (define (system-qemu-image)
"Return the derivation of a QEMU image of the GNU system." "Return the derivation of a QEMU image of the GNU system."
(define build-user-gid 30000)
(mlet* %store-monad (mlet* %store-monad
((services (listm %store-monad ((services (listm %store-monad
(host-name-service "gnu") (host-name-service "gnu")
@ -565,8 +563,6 @@ (define build-user-gid 30000)
#:allow-empty-passwords? #t #:allow-empty-passwords? #t
#:motd motd))) #:motd motd)))
(build-accounts (guix-build-accounts 10 #:gid build-user-gid))
(bash-file (package-file bash "bin/bash")) (bash-file (package-file bash "bin/bash"))
(dmd-file (package-file dmd "bin/dmd")) (dmd-file (package-file dmd "bin/dmd"))
(dmd-conf (dmd-configuration-file services)) (dmd-conf (dmd-configuration-file services))
@ -584,19 +580,23 @@ (define build-user-gid 30000)
(comment "Guest of GNU") (comment "Guest of GNU")
(home-directory "/home/guest") (home-directory "/home/guest")
(shell bash-file)) (shell bash-file))
build-accounts)) (append-map service-user-accounts
(groups -> (list (user-group services)))
(name "root") (groups -> (cons* (user-group
(id 0)) (name "root")
(user-group (id 0))
(name "users") (user-group
(id 100) (name "users")
(members '("guest"))) (id 100)
(user-group (members '("guest")))
(name "guixbuild") (append-map service-user-groups services)))
(id build-user-gid) (build-user-gid -> (any (lambda (service)
(members (map user-account-name (and (equal? '(guix-daemon)
build-accounts))))) (service-provision service))
(match (service-user-groups service)
((group)
(user-group-id group)))))
services))
(packages -> `(("coreutils" ,coreutils) (packages -> `(("coreutils" ,coreutils)
("bash" ,bash) ("bash" ,bash)
("guile" ,guile-2.0) ("guile" ,guile-2.0)