From d0c66871b12c491eca6a80c09b836f893c1d4234 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Thu, 26 Sep 2013 23:28:17 +0200
Subject: [PATCH] gnu: vm: Add build users.

* gnu/system/shadow.scm (guix-build-accounts): New procedure.
* gnu/system/vm.scm (system-qemu-image): Use it.  Add the "guixbuild"
  group.
* gnu/system/dmd.scm (guix-service): Add 'builder-group' parameter.
  Pass 'guix-daemon' the '--build-users-group' option.
---
 gnu/system/dmd.scm    |  6 ++++--
 gnu/system/shadow.scm | 32 ++++++++++++++++++++++++++++++--
 gnu/system/vm.scm     | 39 ++++++++++++++++++++++++---------------
 3 files changed, 58 insertions(+), 19 deletions(-)

diff --git a/gnu/system/dmd.scm b/gnu/system/dmd.scm
index bcafd910dd..8cc3f61c74 100644
--- a/gnu/system/dmd.scm
+++ b/gnu/system/dmd.scm
@@ -146,14 +146,16 @@
      (inputs `(("inetutils" ,inetutils)
                ("syslog.conf" ,syslog.conf))))))
 
-(define* (guix-service store #:key (guix guix))
+(define* (guix-service store #:key (guix guix) (builder-group "guixbuild"))
   "Return a service that runs the build daemon from GUIX."
   (let* ((drv    (package-derivation store guix))
          (daemon (string-append (derivation->output-path drv)
                                 "/bin/guix-daemon")))
     (service
      (provision '(guix-daemon))
-     (start `(make-forkexec-constructor ,daemon))
+     (start `(make-forkexec-constructor ,daemon
+                                        "--build-users-group"
+                                        ,builder-group))
      (inputs `(("guix" ,guix))))))
 
 (define* (static-networking-service store interface ip
diff --git a/gnu/system/shadow.scm b/gnu/system/shadow.scm
index b2a2121b08..4f59b2b325 100644
--- a/gnu/system/shadow.scm
+++ b/gnu/system/shadow.scm
@@ -18,8 +18,14 @@
 
 (define-module (gnu system shadow)
   #:use-module (guix store)
-  #:use-module (ice-9 match)
   #:use-module (guix records)
+  #:use-module (guix packages)
+  #: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
@@ -38,7 +44,8 @@
             user-group-members
 
             passwd-file
-            group-file))
+            group-file
+            guix-build-accounts))
 
 ;;; Commentary:
 ;;;
@@ -110,4 +117,25 @@ file."
   (add-text-to-store store (if shadow? "shadow" "passwd")
                      contents '()))
 
+(define* (guix-build-accounts store 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."
+  (let* ((gid*     gid)
+         (no-login (string-append (package-output store shadow) "/sbin/nologin")))
+    (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 52beb18108..daa023458e 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -462,6 +462,9 @@ Happy birthday, GNU!                                http://www.gnu.org/gnu30
           (static-networking-service store "eth0" "10.0.2.10"
                                      #:gateway "10.0.2.2")))
 
+  (define build-accounts
+    (guix-build-accounts store 10))
+
   (define resolv.conf
     ;; Name resolution for default QEMU settings.
     (add-text-to-store store "resolv.conf"
@@ -482,20 +485,21 @@ Happy birthday, GNU!                                http://www.gnu.org/gnu30
            (dmd-file  (string-append (derivation->output-path dmd-drv)
                                      "/bin/dmd"))
            (dmd-conf  (dmd-configuration-file store %dmd-services))
-           (accounts  (list (user-account
-                             (name "root")
-                             (password "")
-                             (uid 0) (gid 0)
-                             (comment "System administrator")
-                             (home-directory "/")
-                             (shell bash-file))
-                            (user-account
-                             (name "guest")
-                             (password "")
-                             (uid 1000) (gid 100)
-                             (comment "Guest of GNU")
-                             (home-directory "/home/guest")
-                             (shell bash-file))))
+           (accounts  (cons* (user-account
+                              (name "root")
+                              (password "")
+                              (uid 0) (gid 0)
+                              (comment "System administrator")
+                              (home-directory "/")
+                              (shell bash-file))
+                             (user-account
+                              (name "guest")
+                              (password "")
+                              (uid 1000) (gid 100)
+                              (comment "Guest of GNU")
+                              (home-directory "/home/guest")
+                              (shell bash-file))
+                             build-accounts))
            (passwd    (passwd-file store accounts))
            (shadow    (passwd-file store accounts #:shadow? #t))
            (group     (group-file store
@@ -505,7 +509,12 @@ Happy birthday, GNU!                                http://www.gnu.org/gnu30
                                         (user-group
                                          (name "users")
                                          (id 100)
-                                         (members '("guest"))))))
+                                         (members '("guest")))
+                                        (user-group
+                                         (name "guixbuild")
+                                         (id 30000)
+                                         (members (map user-account-name
+                                                       build-accounts))))))
            (pam.d-drv (pam-services->directory store %pam-services))
            (pam.d     (derivation->output-path pam.d-drv))