[PATCH] dmd: Add support for exec'ing processes as other users

[Andy Wingo]

Hi,

The attached patch adds #:user and #:group kwargs to
make-fork+exec-constructor in DMD, to allow DMD to change users before
execing the sub-process.  I couldn't figure out how to make a proper
test but it works for me and GeoClue.

The patch is formulated as a patch against Guix adding a DMD patch.  The
DMD patch itself can be applied directly to DMD's git repo.  As they are
maintained together AFAIU I guess this is the right thing?  Let me know.

Andy

>From 4b4e1f5e3905b282c09c1e10e2e50d434be673da Mon Sep 17 00:00:00 2001
From: Andy Wingo <address@hidden>
Date: Sat, 15 Aug 2015 20:18:36 +0200
Subject: [PATCH 1/2] gnu: dmd: Add user-group patch.

* gnu/packages/patches/dmd-user-group.patch: New file.
* gnu/packages/admin.scm (dmd): Add patch to allow services to exec their
  commands as a particular user.
---
 gnu/packages/admin.scm                    |   4 +-
 gnu/packages/patches/dmd-user-group.patch | 176 ++++++++++++++++++++++++++++++
 2 files changed, 179 insertions(+), 1 deletion(-)
 create mode 100644 gnu/packages/patches/dmd-user-group.patch

diff --git a/gnu/packages/admin.scm b/gnu/packages/admin.scm
index 319e78c..4af1ba5 100644
--- a/gnu/packages/admin.scm
+++ b/gnu/packages/admin.scm
@@ -69,7 +69,9 @@
                                  version ".tar.gz"))
              (sha256
               (base32
-               "10fl4k96f17gqx2fv8iw9c61ld26gsk4bbrlfqckdmiimz1k175z"))))
+               "10fl4k96f17gqx2fv8iw9c61ld26gsk4bbrlfqckdmiimz1k175z"))
+             (patches
+              (map search-patch '("dmd-user-group.patch")))))
     (build-system gnu-build-system)
     (arguments
      '(#:configure-flags '("--localstatedir=/var")))
diff --git a/gnu/packages/patches/dmd-user-group.patch 
b/gnu/packages/patches/dmd-user-group.patch
new file mode 100644
index 0000000..6603395
--- /dev/null
+++ b/gnu/packages/patches/dmd-user-group.patch
@@ -0,0 +1,176 @@
+From 06115c34a3648ef29c05612acb6f1b383146f342 Mon Sep 17 00:00:00 2001
+From: Andy Wingo <address@hidden>
+Date: Sat, 15 Aug 2015 20:10:20 +0200
+Subject: [PATCH] Add ability to set user and group before exec'ing a command
+
+* dmd.texi (Service De- and Constructors): Document #:user and #:group
+  options.
+
+* modules/dmd/service.scm (exec-command, fork+exec-command):
+  (make-forkexec-constructor): Add #:user and #:group keyword arguments.
+---
+ dmd.texi                | 24 +++++++++++++++++++-----
+ modules/dmd/service.scm | 50 +++++++++++++++++++++++++++++++++++++++++++------
+ 2 files changed, 63 insertions(+), 11 deletions(-)
+
+diff --git a/dmd.texi b/dmd.texi
+index 206f0a2..97ed341 100644
+--- a/dmd.texi
++++ b/dmd.texi
+@@ -807,14 +807,17 @@ execution of the @var{command} was successful, @code{#t} 
if not.
+ @end deffn
+ 
+ @deffn {procedure} make-forkexec-constructor @var{command} @
++  [#:user #f] @
++  [#:group #f] @
+   [#:directory (default-service-directory)] @
+   [#:environment-variables (default-environment-variables)]
+ Return a procedure that forks a child process, close all file
+ descriptors except the standard output and standard error descriptors,
+ sets the current directory to @var{directory}, changes the environment
+-to @var{environment-variables} (using the @code{environ} procedure), and
+-executes @var{command} (a list of strings.)  Return the PID of the child
+-process.
++to @var{environment-variables} (using the @code{environ} procedure),
++sets the current user to @var{user} and the current group to
address@hidden, and executes @var{command} (a list of strings.)  The
++result of the procedure will be the PID of the child process.
+ @end deffn
+ 
+ @deffn {procedure} make-kill-destructor address@hidden
+@@ -830,9 +833,13 @@ The @code{make-forkexec-constructor} procedure builds 
upon the following
+ procedures.
+ 
+ @deffn {procedure} exec-command @var{command} @
++  [#:user #f] @
++  [#:group #f] @
+   [#:directory (default-service-directory)] @
+   [#:environment-variables (default-environment-variables)]
+ @deffnx {procedure} fork+exec-command @var{command} @
++  [#:user #f] @
++  [#:group #f] @
+   [#:directory (default-service-directory)] @
+   [#:environment-variables (default-environment-variables)]
+ Run @var{command} as the current process from @var{directory}, and with
+@@ -841,8 +848,15 @@ File descriptors 1 and 2 are kept as is, whereas file 
descriptor 0
+ (standard input) points to @file{/dev/null}; all other file descriptors
+ are closed prior to yielding control to @var{command}.
+ 
address@hidden does the same, but in a separate process whose
+-PID it returns.
++By default, @var{command} is run as the current user.  If the
address@hidden keyword argument is present and not false, change to
address@hidden immediately before invoking @var{command}.  @var{user} may
++be a string, indicating a user name, or a number, indicating a user
++ID.  Likewise, @var{command} will be run under the current group,
++unless the @var{group} keyword argument is present and not false.
++
address@hidden does the same as @code{exec-command}, but in
++a separate process whose PID it returns.
+ @end deffn
+ 
+ @c @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
+diff --git a/modules/dmd/service.scm b/modules/dmd/service.scm
+index dd5afe3..67156dd 100644
+--- a/modules/dmd/service.scm
++++ b/modules/dmd/service.scm
+@@ -575,13 +575,22 @@ set when starting a service."
+ 
+ (define* (exec-command command
+                        #:key
++                       (user #f)
++                       (group #f)
+                        (directory (default-service-directory))
+                        (environment-variables 
(default-environment-variables)))
+   "Run COMMAND as the current process from DIRECTORY, and with
+ ENVIRONMENT-VARIABLES (a list of strings like \"PATH=/bin\".)  File
+-descriptors 1 and 2 are kept as is, whereas file descriptor 0 (standard
+-input) points to /dev/null; all other file descriptors are closed prior to
+-yielding control to COMMAND."
++descriptors 1 and 2 are kept as is, whereas file descriptor
++0 (standard input) points to /dev/null; all other file descriptors are
++closed prior to yielding control to COMMAND.
++
++By default, COMMAND is run as the current user.  If the USER keyword
++argument is present and not false, change to USER immediately before
++invoking COMMAND.  USER may be a string, indicating a user name, or a
++number, indicating a user ID.  Likewise, COMMAND will be run under the
++current group, unless the GROUP keyword argument is present and not
++false."
+   (match command
+     ((program args ...)
+      ;; Become the leader of a new session and session group.
+@@ -604,6 +613,26 @@ yielding control to COMMAND."
+            (catch-system-error (close-fdes i))
+            (loop (+ i 1)))))
+ 
++     (when user
++       (catch #t
++         (lambda ()
++           (setuid (passwd:uid (getpw user))))
++         (lambda (key . args)
++           (format (current-error-port)
++                   "failed to change to user ~s:~%" user)
++           (print-exception (current-error-port) #f key args)
++           (primitive-exit 1))))
++
++     (when group
++       (catch #t
++         (lambda ()
++           (setgid (group:gid (getgr group))))
++         (lambda (key . args)
++           (format (current-error-port)
++                   "failed to change to group ~s:~%" group)
++           (print-exception (current-error-port) #f key args)
++           (primitive-exit 1))))
++
+      (catch 'system-error
+        (lambda ()
+          (apply execlp program program args))
+@@ -615,6 +644,8 @@ yielding control to COMMAND."
+ 
+ (define* (fork+exec-command command
+                             #:key
++                            (user #f)
++                            (group #f)
+                             (directory (default-service-directory))
+                             (environment-variables
+                              (default-environment-variables)))
+@@ -623,6 +654,8 @@ its PID."
+   (let ((pid (primitive-fork)))
+     (if (zero? pid)
+         (exec-command command
++                      #:user user
++                      #:group group
+                       #:directory directory
+                       #:environment-variables environment-variables)
+         pid)))
+@@ -636,10 +669,13 @@ its PID."
+  (make-forkexec-constructor '(\"PROGRAM\" \"ARGS\"...)."))))
+     (case-lambda*
+      "Produce a constructor that execs COMMAND, a program name/argument list,
+-in a child process and returns its PID.  COMMAND is started with DIRECTORY as
+-its current directory, and ENVIRONMENT-VARIABLES as its environment
+-variables."
++in a child process and returns its PID.  COMMAND is started with
++DIRECTORY as its current directory, and ENVIRONMENT-VARIABLES as its
++environment variables.  If USER and/or GROUP are given, switch to the
++given USER and/or GROUP to run COMMAND."
+      ((command #:key
++               (user #f)
++               (group #f)
+                (directory (default-service-directory))
+                (environment-variables (default-environment-variables)))
+       (let ((command (if (string? command)
+@@ -649,6 +685,8 @@ variables."
+                          command)))
+         (lambda args
+           (fork+exec-command command
++                             #:user user
++                             #:group group
+                              #:directory directory
+                              #:environment-variables environment-variables))))
+      ((program . program-args)
+-- 
+2.4.3
+
-- 
2.4.3