From e0bd47b4fd5eb009f34004242e16b976e58756b0 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 12 Aug 2021 11:58:47 +0200 Subject: 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 '# "/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 , 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 records. * gnu/system.scm ()[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 2a8114a219..1655218f2d 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 +;;; Copyright © 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès ;;; Copyright © 2016 Chris Marusich ;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen ;;; Copyright © 2020, 2021 Ricardo Wurmus @@ -828,16 +828,6 @@ (define (setuid-program->activation-gexp programs) (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 @@ (define setuid-program-service-type 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 7e11d38c59..4b57f1a8bb 100644 --- a/gnu/system.scm +++ b/gnu/system.scm @@ -268,8 +268,9 @@ (define-record-type* operating-system (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 + (sanitize ensure-setuid-program-list)) (sudoers-file operating-system-sudoers-file ; file-like (default %sudoers-specification)) @@ -672,7 +673,7 @@ (define known-fs (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 @@ (define (hurd-default-essential-services os) (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 @@ (define (operating-system-environment-variables os) ;; 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 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. -- cgit v1.2.3