(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)
                  ;; Ensure that setuid programs are set up by the time they
                  ;; might be needed by user-configured processes and daemons.
                  (service-extension user-processes-service-type
                                     (const '(setuid-programs)))))
                (compose concatenate)
                (extend append)
                (default-value '())
                (description
                 "Populate @file{/run/setuid-programs} with the specified
executables, making them setuid and/or setgid.")))