summary refs log tree commit diff
diff options
context:
space:
mode:
authorTobias Geerinckx-Rice <me@tobias.gr>2024-09-01 02:00:00 +0200
committerTobias Geerinckx-Rice <me@tobias.gr>2024-09-08 02:00:00 +0200
commit0dd8e4c35109ed8bc2406a0bc13e18823a334937 (patch)
tree89f7991bf08fd1caa84c4cb3052ecc0ab63f3b21
parent67a2073d279e064b6b065541be9502cd6ead80c8 (diff)
downloadguix-0dd8e4c35109ed8bc2406a0bc13e18823a334937.tar.gz
privilege: Add file-like->setuid-program helper.
* gnu/system/privilege.scm (file-like->setuid-program): New public
procedure.
* gnu/system/setuid.scm: Re-export it for compatibility.
(file-like->setuid-program): Remove this old version.
* gnu/services/docker.scm (singularity-setuid-programs): Use it (again).
* gnu/services/desktop.scm (enlightenment-privileged-programs): Likewise.

Change-Id: I8e41144438677a15cdadb3063651dbc780715497
-rw-r--r--gnu/services/desktop.scm3
-rw-r--r--gnu/services/docker.scm3
-rw-r--r--gnu/system/privilege.scm10
-rw-r--r--gnu/system/setuid.scm8
4 files changed, 13 insertions, 11 deletions
diff --git a/gnu/services/desktop.scm b/gnu/services/desktop.scm
index 8afb54ae48..041a1aab0f 100644
--- a/gnu/services/desktop.scm
+++ b/gnu/services/desktop.scm
@@ -1736,8 +1736,7 @@ need to create it beforehand."))))
   (match-record enlightenment-desktop-configuration
       <enlightenment-desktop-configuration>
     (enlightenment)
-    (map (lambda (program) (privileged-program (program program)
-                                               (setuid? #t)))
+    (map file-like->setuid-program
          (list (file-append enlightenment
                             "/lib/enlightenment/utils/enlightenment_sys")
                (file-append enlightenment
diff --git a/gnu/services/docker.scm b/gnu/services/docker.scm
index f0ac69a87e..3af0f79270 100644
--- a/gnu/services/docker.scm
+++ b/gnu/services/docker.scm
@@ -286,8 +286,7 @@ bundles in Docker containers.")
                                                            "-helper")))
                                  '("action" "mount" "start")))))
 
-  (map (lambda (program) (privileged-program (program program)
-                                        (setuid? #t)))
+  (map file-like->setuid-program
        (list (file-append helpers "/singularity-action-helper")
              (file-append helpers "/singularity-mount-helper")
              (file-append helpers "/singularity-start-helper"))))
diff --git a/gnu/system/privilege.scm b/gnu/system/privilege.scm
index d89d5d5d1c..fe6e60ad7c 100644
--- a/gnu/system/privilege.scm
+++ b/gnu/system/privilege.scm
@@ -26,7 +26,9 @@
             privileged-program-setgid?
             privileged-program-user
             privileged-program-group
-            privileged-program-capabilities))
+            privileged-program-capabilities
+
+            file-like->setuid-program))
 
 ;;; Commentary:
 ;;;
@@ -56,3 +58,9 @@
   ;; POSIX capabilities in cap_from_text(3) form (defaults to #f: none).
   (capabilities  privileged-program-capabilities ;string or #f
                  (default #f)))
+
+(define (file-like->setuid-program program)
+  "Simple wrapper to facilitate MAPping over a list of file-like objects and
+make them setuid, a pattern just common enough to justify a special helper."
+  (privileged-program (program program)
+                      (setuid? #t)))
diff --git a/gnu/system/setuid.scm b/gnu/system/setuid.scm
index 4dd0cc8962..097797ce8d 100644
--- a/gnu/system/setuid.scm
+++ b/gnu/system/setuid.scm
@@ -21,15 +21,14 @@
   #:use-module (gnu system privilege)
   #:use-module (ice-9 match)
   #:use-module (srfi srfi-1)
+  #:re-export (file-like->setuid-program)
   #:export (setuid-program
             setuid-program?
             setuid-program-program
             setuid-program-setuid?
             setuid-program-setgid?
             setuid-program-user
-            setuid-program-group
-
-            file-like->setuid-program))
+            setuid-program-group))
 
 ;;; Commentary:
 ;;;
@@ -56,6 +55,3 @@
 (define setuid-program-setgid? privileged-program-setgid?)
 (define setuid-program-user    privileged-program-user)
 (define setuid-program-group   privileged-program-group)
-
-(define (file-like->setuid-program program)
-  (setuid-program (program program)))