mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
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.
This commit is contained in:
Ludovic Courtès
parent
25ed6edb6c
commit
18fb40e414
3 changed files with 62 additions and 45 deletions
|
|
@ -24,13 +24,16 @@ (define-module (gnu system dmd)
|
|||
#: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 @@ (define-module (gnu system dmd)
|
|||
service-start
|
||||
service-stop
|
||||
service-inputs
|
||||
service-user-accounts
|
||||
service-user-groups
|
||||
|
||||
host-name-service
|
||||
syslog-service
|
||||
|
|
@ -70,6 +75,10 @@ (define-record-type* <service>
|
|||
(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 @@ (define contents "
|
|||
(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
|
||||
|
|
|
|||
|
|
@ -24,9 +24,7 @@ (define-module (gnu system shadow)
|
|||
#: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 @@ (define 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
|
||||
|
|
|
|||
|
|
@ -535,8 +535,6 @@ (define* (etc-directory #:key
|
|||
|
||||
(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 @@ (define build-user-gid 30000)
|
|||
#: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 @@ (define build-user-gid 30000)
|
|||
(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)
|
||||
|
|
|
|||
Loading…
Reference in a new issue