04/06: system: Handle 'setuid-programs' deprecation handling as a field sanitizer.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit e0bd47b4fd5eb009f34004242e16b976e58756b0
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Thu Aug 12 11:58:47 2021 +0200

    system: Handle 'setuid-programs' deprecation handling as a field sanitizer.
    
    Previously, evaluating an OS configuration with a childhurd (for
    instance) would produce tens of lines like:
    
      guix system: warning: representing setuid programs with '#<file-append 
#<package shadow@4.8.1 gnu/packages/admin.scm:798 7ff97f6f7640> "/bin/passwd">' 
is deprecated; use 'setuid-program' instead
    
    Now, it prints this one line:
    
      gnu/system/hurd.scm:105:2: warning: representing setuid programs with 
file-like objects is deprecated; use 'setuid-program' instead
    
    This change also means that extensions of 'setuid-program-service-type'
    now have to provide a list of <setuid-program>, so it's stricter in this
    sense.
    
    * gnu/services.scm (setuid-program-file-like-deprecated): Remove.
    (setuid-program-service-type)[extend]: Remove
    'setuid-program-file-like-deprecated' call.  Assume CONFIG and
    EXTENSIONS are already lists of <setuid-program> records.
    * gnu/system.scm (<operating-system>)[setuid-programs]: Add 'sanitize'
    property.  Change accessor name from '%operating-system-setuid-programs'
    to 'operating-system-setuid-programs'.
    (operating-system-default-essential-services)
    (hurd-default-essential-services): Adjust accordingly.
    (ensure-setuid-program-list): New macro.
    (%ensure-setuid-program-list): New procedure, based on
    'setuid-program-file-like-deprecated'.
---
 gnu/services.scm | 15 ++-------------
 gnu/system.scm   | 34 ++++++++++++++++++++++++++--------
 2 files changed, 28 insertions(+), 21 deletions(-)

diff --git a/gnu/services.scm b/gnu/services.scm
index 2a8114a..1655218 100644
--- a/gnu/services.scm
+++ b/gnu/services.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès 
<ludo@gnu.org>
+;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès 
<ludo@gnu.org>
 ;;; Copyright © 2016 Chris Marusich <cmmarusich@gmail.com>
 ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2020, 2021 Ricardo Wurmus <rekado@elephly.net>
@@ -828,16 +828,6 @@ FILES must be a list of name/file-like object pairs."
 
           (activate-setuid-programs (list #$@programs))))))
 
-(define (setuid-program-file-like-deprecated file-like)
-  (match file-like
-    ((? file-like? program)
-     (warning
-      (G_ "representing setuid programs with '~a' is \
-deprecated; use 'setuid-program' instead~%") program)
-     (setuid-program (program program)))
-    ((? setuid-program? program)
-     program)))
-
 (define setuid-program-service-type
   (service-type (name 'setuid-program)
                 (extensions
@@ -845,8 +835,7 @@ deprecated; use 'setuid-program' instead~%") program)
                                           setuid-program->activation-gexp)))
                 (compose concatenate)
                 (extend (lambda (config extensions)
-                          (map setuid-program-file-like-deprecated
-                               (append config extensions))))
+                          (append config extensions)))
                 (description
                  "Populate @file{/run/setuid-programs} with the specified
 executables, making them setuid-root.")))
diff --git a/gnu/system.scm b/gnu/system.scm
index 7e11d38..4b57f1a 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -268,8 +268,9 @@
 
   (pam-services operating-system-pam-services     ; list of PAM services
                 (default (base-pam-services)))
-  (setuid-programs %operating-system-setuid-programs
-                   (default %setuid-programs))    ; list of string-valued gexps
+  (setuid-programs operating-system-setuid-programs
+                   (default %setuid-programs)     ; list of <setuid-program>
+                   (sanitize ensure-setuid-program-list))
 
   (sudoers-file operating-system-sudoers-file     ; file-like
                 (default %sudoers-specification))
@@ -672,7 +673,7 @@ bookkeeping."
             (operating-system-environment-variables os))
            host-name procs root-fs
            (service setuid-program-service-type
-                    (%operating-system-setuid-programs os))
+                    (operating-system-setuid-programs os))
            (service profile-service-type
                     (operating-system-packages os))
            other-fs
@@ -702,7 +703,7 @@ bookkeeping."
           (pam-root-service (operating-system-pam-services os))
           (operating-system-etc-service os)
           (service setuid-program-service-type
-                   (%operating-system-setuid-programs os))
+                   (operating-system-setuid-programs os))
           (service profile-service-type (operating-system-packages os)))))
 
 (define* (operating-system-services os)
@@ -1066,10 +1067,27 @@ use 'plain-file' instead~%")
     ;; TODO: Remove when glibc@2.23 is long gone.
     ("GUIX_LOCPATH" . "/run/current-system/locale")))
 
-(define (operating-system-setuid-programs os)
-  "Return the setuid programs for OS, as a list of setuid-program record."
-  (map file-like->setuid-program
-         (%operating-system-setuid-programs os)))
+(define-syntax-rule (ensure-setuid-program-list lst)
+  "Ensure LST is a list of <setuid-program> records and warn otherwise."
+  (%ensure-setuid-program-list lst (current-source-location)))
+
+(define (%ensure-setuid-program-list lst location)
+  (define warned? #f)
+
+  (define (warn-once)
+    (unless warned?
+      (warning (source-properties->location location)
+               (G_ "representing setuid programs with file-like objects is \
+deprecated; use 'setuid-program' instead~%"))
+      (set! warned? #t)))
+
+  (map (match-lambda
+         ((? file-like? program)
+          (warn-once)
+          (setuid-program (program program)))
+         ((? setuid-program? program)
+          program))
+       lst))
 
 (define %setuid-programs
   ;; Default set of setuid-root programs.