services: Rename setuid-program-service-type.

* gnu/services.scm (setuid-program->activation-gexp): Rename this…
(privileged-program->activation-gexp): …to this.
Operate on a list of <privileged-program> records.
(privileged-program-service-type): New variable, renamed from
setuid-program-service-type.  Rename the service-type accordingly.
(setuid-program-service-type): Redefine as an alias for the above.
This commit is contained in:
Tobias Geerinckx-Rice 2022-10-23 02:00:15 +02:00
parent f3b84be52d
commit d73ca7ecb6
No known key found for this signature in database
GPG Key ID: 0DB0FF884F556D79

View File

@ -46,6 +46,7 @@
#:use-module (gnu packages base) #:use-module (gnu packages base)
#:use-module (gnu packages bash) #:use-module (gnu packages bash)
#:use-module (gnu packages hurd) #:use-module (gnu packages hurd)
#:use-module (gnu system privilege)
#:use-module (gnu system setuid) #:use-module (gnu system setuid)
#:use-module (srfi srfi-1) #:use-module (srfi srfi-1)
#:use-module (srfi srfi-9) #:use-module (srfi srfi-9)
@ -120,7 +121,8 @@
extra-special-file extra-special-file
etc-service-type etc-service-type
etc-directory etc-directory
setuid-program-service-type privileged-program-service-type
setuid-program-service-type ; deprecated
profile-service-type profile-service-type
firmware-service-type firmware-service-type
gc-root-service-type gc-root-service-type
@ -889,17 +891,17 @@ directory."
FILES must be a list of name/file-like object pairs." FILES must be a list of name/file-like object pairs."
(service etc-service-type files)) (service etc-service-type files))
(define (setuid-program->activation-gexp programs) (define (privileged-program->activation-gexp programs)
"Return an activation gexp for setuid-program from PROGRAMS." "Return an activation gexp for privileged-program from PROGRAMS."
(let ((programs (map (lambda (program) (let ((programs (map (lambda (program)
;; FIXME This is really ugly, I didn't managed to use ;; FIXME This is really ugly, I didn't managed to use
;; "inherit" ;; "inherit"
(let ((program-name (setuid-program-program program)) (let ((program-name (privileged-program-program program))
(setuid? (setuid-program-setuid? program)) (setuid? (privileged-program-setuid? program))
(setgid? (setuid-program-setgid? program)) (setgid? (privileged-program-setgid? program))
(user (setuid-program-user program)) (user (privileged-program-user program))
(group (setuid-program-group program)) ) (group (privileged-program-group program)) )
#~(setuid-program #~(privileged-program
(setuid? #$setuid?) (setuid? #$setuid?)
(setgid? #$setgid?) (setgid? #$setgid?)
(user #$user) (user #$user)
@ -907,17 +909,17 @@ FILES must be a list of name/file-like object pairs."
(program #$program-name)))) (program #$program-name))))
programs))) programs)))
(with-imported-modules (source-module-closure (with-imported-modules (source-module-closure
'((gnu system setuid))) '((gnu system privilege)))
#~(begin #~(begin
(use-modules (gnu system setuid)) (use-modules (gnu system privilege))
(activate-privileged-programs (list #$@programs)))))) (activate-privileged-programs (list #$@programs))))))
(define setuid-program-service-type (define privileged-program-service-type
(service-type (name 'setuid-program) (service-type (name 'privileged-program)
(extensions (extensions
(list (service-extension activation-service-type (list (service-extension activation-service-type
setuid-program->activation-gexp))) privileged-program->activation-gexp)))
(compose concatenate) (compose concatenate)
(extend (lambda (config extensions) (extend (lambda (config extensions)
(append config extensions))) (append config extensions)))
@ -929,6 +931,10 @@ The deprecated @file{/run/setuid-programs} directory is also populated with
symbolic links to their @file{/run/privileged/bin} counterpart. It will be symbolic links to their @file{/run/privileged/bin} counterpart. It will be
removed in a future Guix release."))) removed in a future Guix release.")))
(define setuid-program-service-type
;; Deprecated alias to ease transition. Will be removed!
privileged-program-service-type)
(define (packages->profile-entry packages) (define (packages->profile-entry packages)
"Return a system entry for the profile containing PACKAGES." "Return a system entry for the profile containing PACKAGES."
;; XXX: 'mlet' is needed here for one reason: to get the proper ;; XXX: 'mlet' is needed here for one reason: to get the proper