services: Warn about unprivileged privileged-programs.

* gnu/services.scm (privileged-program->activation-gexp): Warn when a
privileged-program appears to lack all possible privilege.

Change-Id: I68ed8cb2cff88b11b090cf99a2cc7d6264b888e0

1 files changed, 20 insertions, 17 deletions

diff --git a/gnu/services.scm b/gnu/services.scm
index f0bbbb27a51..8d0d5a08b45 100644
--- a/gnu/services.scm
+++ b/gnu/services.scm
@@ -893,23 +893,26 @@ FILES must be a list of name/file-like object pairs."
 
 (define (privileged-program->activation-gexp programs)
   "Return an activation gexp for privileged-program from PROGRAMS."
-  (let ((programs (map (lambda (program)
-                         ;; FIXME This is really ugly, I didn't managed to use
-                         ;; "inherit"
-                         (let ((program-name (privileged-program-program program))
-                               (setuid?      (privileged-program-setuid? program))
-                               (setgid?      (privileged-program-setgid? program))
-                               (user         (privileged-program-user program))
-                               (group        (privileged-program-group program))
-                               (capabilities (privileged-program-capabilities program)))
-                           #~(privileged-program
-                              (setuid? #$setuid?)
-                              (setgid? #$setgid?)
-                              (user    #$user)
-                              (group   #$group)
-                              (capabilities #$capabilities)
-                              (program #$program-name))))
-                       programs)))
+  (let ((programs
+         (map (lambda (program)
+                ;; FIXME This is really ugly, I didn't manage to use "inherit".
+                (let ((program-name (privileged-program-program program))
+                      (setuid?      (privileged-program-setuid? program))
+                      (setgid?      (privileged-program-setgid? program))
+                      (user         (privileged-program-user program))
+                      (group        (privileged-program-group program))
+                      (capabilities (privileged-program-capabilities program)))
+                  (unless (or setuid? setgid? capabilities)
+                    (warning
+                     (G_ "so-called privileged-program ~s lacks any privilege~%")
+                     program-name))
+                  #~(privileged-program (setuid? #$setuid?)
+                                        (setgid? #$setgid?)
+                                        (user    #$user)
+                                        (group   #$group)
+                                        (capabilities #$capabilities)
+                                        (program #$program-name))))
+              programs)))
     (with-imported-modules (source-module-closure
                             '((gnu system privilege)))
       #~(begin