[bug#61462] [PATCH 06/10] system: (gnu system setuid) wraps (gnu system privilege).

[Tobias Geerinckx-Rice]

* gnu/system/setuid.scm (setuid-program): Rewrite as syntax to create a
<privileged-program> record that is setuid by default.
(setuid-program?, setuid-program-program, setuid-program-setuid?)
(setuid-program-setgid?, setuid-program-user, setuid-program-group):
Alias their privileged-program equivalent.
---
 gnu/system/setuid.scm | 44 +++++++++++++++++++++++--------------------
 1 file changed, 24 insertions(+), 20 deletions(-)

diff --git a/gnu/system/setuid.scm b/gnu/system/setuid.scm
index 83111d932c..4dd0cc8962 100644
--- a/gnu/system/setuid.scm
+++ b/gnu/system/setuid.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
+;;; Copyright © 2022 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -17,7 +18,9 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (gnu system setuid)
-  #:use-module (guix records)
+  #:use-module (gnu system privilege)
+  #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
   #:export (setuid-program
             setuid-program?
             setuid-program-program
@@ -30,28 +33,29 @@ (define-module (gnu system setuid)
 
 ;;; Commentary:
 ;;;
-;;; Data structures representing setuid/setgid programs.  This is meant to be
-;;; used both on the host side and at run time--e.g., in activation snippets.
+;;; Do not use this module in new code.  It used to define data structures
+;;; representing setuid/setgid programs, but is now a mere compatibility shim
+;;; wrapping a subset of (gnu system privilege).
 ;;;
 ;;; Code:
 
-(define-record-type* <setuid-program>
-  setuid-program make-setuid-program
-  setuid-program?
-  ;; Path to program to link with setuid permissions
-  (program       setuid-program-program) ;file-like
-  ;; Whether to set user setuid bit
-  (setuid?       setuid-program-setuid? ;boolean
-                 (default #t))
-  ;; Whether to set group setgid bit
-  (setgid?       setuid-program-setgid? ;boolean
-                 (default #f))
-  ;; The user this should be set to (defaults to root)
-  (user          setuid-program-user    ;integer or string
-                 (default 0))
-  ;; Group we want to set this to (defaults to root)
-  (group         setuid-program-group   ;integer or string
-                 (default 0)))
+(define-syntax setuid-program
+  (lambda (fields)
+    (syntax-case fields ()
+      ((_ (field value) ...)
+       #`(privileged-program
+          (setuid? (match (assoc-ref '((field value) ...) 'setuid?)
+                     ((#f) #f)
+                     (_ #t)))
+          #,@(remove (match-lambda ((f _) (eq? (syntax->datum f) 'setuid?)))
+                     #'((field value) ...)))))))
+
+(define setuid-program?        privileged-program?)
+(define setuid-program-program privileged-program-program)
+(define setuid-program-setuid? privileged-program-setuid?)
+(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)))
-- 
2.39.1