@@ -704,6 +704,7 @@ GNU_SYSTEM_MODULES = \
%D%/services/rsync.scm \
%D%/services/samba.scm \
%D%/services/sddm.scm \
+ %D%/services/setuid.scm \
%D%/services/spice.scm \
%D%/services/ssh.scm \
%D%/services/syncthing.scm \
@@ -43,7 +43,6 @@ (define-module (gnu services)
#:use-module (gnu packages base)
#:use-module (gnu packages bash)
#:use-module (gnu packages hurd)
- #:use-module (gnu system setuid)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
#:use-module (srfi srfi-9 gnu)
@@ -110,7 +109,7 @@ (define-module (gnu services)
extra-special-file
etc-service-type
etc-directory
- setuid-program-service-type
+ setuid-program-service-type ; deprecated
profile-service-type
firmware-service-type
gc-root-service-type
@@ -811,41 +810,8 @@ (define-deprecated (etc-service files)
FILES must be a list of name/file-like object pairs."
(service etc-service-type files))
-(define (setuid-program->activation-gexp programs)
- "Return an activation gexp for setuid-program from PROGRAMS."
- (let ((programs (map (lambda (program)
- ;; FIXME This is really ugly, I didn't managed to use
- ;; "inherit"
- (let ((program-name (setuid-program-program program))
- (setuid? (setuid-program-setuid? program))
- (setgid? (setuid-program-setgid? program))
- (user (setuid-program-user program))
- (group (setuid-program-group program)) )
- #~(setuid-program
- (setuid? #$setuid?)
- (setgid? #$setgid?)
- (user #$user)
- (group #$group)
- (program #$program-name))))
- programs)))
- (with-imported-modules (source-module-closure
- '((gnu system setuid)))
- #~(begin
- (use-modules (gnu system setuid))
-
- (activate-setuid-programs (list #$@programs))))))
-
-(define setuid-program-service-type
- (service-type (name 'setuid-program)
- (extensions
- (list (service-extension activation-service-type
- setuid-program->activation-gexp)))
- (compose concatenate)
- (extend (lambda (config extensions)
- (append config extensions)))
- (description
- "Populate @file{/run/setuid-programs} with the specified
-executables, making them setuid and/or setgid.")))
+(define-deprecated/public-alias setuid-program-service-type
+ (@ (gnu services setuid) setuid-program-service-type))
(define (packages->profile-entry packages)
"Return a system entry for the profile containing PACKAGES."
@@ -21,6 +21,7 @@
(define-module (gnu services dbus)
#:use-module (gnu services)
+ #:use-module (gnu services setuid)
#:use-module (gnu services shepherd)
#:use-module (gnu system setuid)
#:use-module (gnu system shadow)
@@ -33,6 +33,7 @@
(define-module (gnu services desktop)
#:use-module (gnu services)
+ #:use-module (gnu services setuid)
#:use-module (gnu services shepherd)
#:use-module (gnu services base)
#:use-module (gnu services dbus)
@@ -26,6 +26,7 @@ (define-module (gnu services docker)
#:use-module (gnu services configuration)
#:use-module (gnu services base)
#:use-module (gnu services dbus)
+ #:use-module (gnu services setuid)
#:use-module (gnu services shepherd)
#:use-module (gnu system setuid)
#:use-module (gnu system shadow)
@@ -27,6 +27,7 @@ (define-module (gnu services mail)
#:use-module (gnu services)
#:use-module (gnu services base)
#:use-module (gnu services configuration)
+ #:use-module (gnu services setuid)
#:use-module (gnu services shepherd)
#:use-module (gnu system pam)
#:use-module (gnu system shadow)
new file mode 100644
@@ -0,0 +1,53 @@
+(define-module (gnu services setuid)
+ #:use-module (gnu services)
+ #:use-module (gnu services shepherd)
+ #:use-module (gnu system setuid)
+ #:use-module (guix gexp)
+ #:use-module (guix modules)
+ #:use-module (srfi srfi-1)
+ #:export (setuid-program-service-type))
+
+(define (setuid-programs->shepherd-service programs)
+ (let ((programs (map (lambda (program)
+ ;; FIXME This is really ugly, I didn't managed to use
+ ;; "inherit"
+ (let ((program-name (setuid-program-program program))
+ (setuid? (setuid-program-setuid? program))
+ (setgid? (setuid-program-setgid? program))
+ (user (setuid-program-user program))
+ (group (setuid-program-group program)) )
+ #~(setuid-program
+ (setuid? #$setuid?)
+ (setgid? #$setgid?)
+ (user #$user)
+ (group #$group)
+ (program #$program-name))))
+ programs)))
+ (with-imported-modules (source-module-closure
+ '((gnu system setuid)
+ (gnu build activation)))
+ (list (shepherd-service
+ (documentation "Populate @file{/run/setuid-programs}.")
+ (provision '(setuid-programs))
+ ;; TODO: actually need to require account service. maybe user-homes
+ ;; as a proxy?
+ (requirement '(file-systems))
+ (one-shot? #t)
+ (modules '((gnu system setuid)
+ (gnu build activation)))
+ (start #~(lambda ()
+ (activate-setuid-programs (list #$@programs))
+ #t)))))))
+
+(define setuid-program-service-type
+ (service-type (name 'setuid-program)
+ (extensions
+ (list
+ (service-extension shepherd-root-service-type
+ setuid-programs->shepherd-service)))
+ (compose concatenate)
+ (extend append)
+ (default-value '())
+ (description
+ "Populate @file{/run/setuid-programs} with the specified
+executables, making them setuid and/or setgid.")))
@@ -34,6 +34,7 @@ (define-module (gnu services xorg)
#:use-module (gnu artwork)
#:use-module (gnu services)
#:use-module (gnu services configuration)
+ #:use-module (gnu services setuid)
#:use-module (gnu services shepherd)
#:use-module (gnu system pam)
#:use-module (gnu system setuid)
@@ -67,6 +67,7 @@ (define-module (gnu system)
#:use-module (gnu packages text-editors)
#:use-module (gnu packages wget)
#:use-module (gnu services)
+ #:use-module (gnu services setuid)
#:use-module (gnu services shepherd)
#:use-module (gnu services base)
#:use-module (gnu bootloader)