Defining shepherd user services -- feedback desired

[Alex ter Weele <alex.ter.weele@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 985 bytes --]


Attached is a manifest file which allows a user to write a
shepherd-service like the following:

(define redshift-service
  (shepherd-service
   (provision '(redshift))
   (modules `((gnu packages xdisorg)
              ,@%default-modules))
   (start #~(make-forkexec-constructor
             (list (string-append #$redshift "/bin/redshift")
                   "-l" "50:4")))))

And transform it into a package:

(services->package (list redshift-service))

This allows it to be included in a user's profile. This unites the
definition of a service with its dependencies (redshift, in the example
above). A user would not have to install a package just to use it as a
service, nor would they have to hand-write a Shepherd configuration
file.

It may be desired to add services->package and my edited version of
shepherd-configuration-file to Guix. I have not written a patch, though,
because I am unsure where it should go and some FIXMEs remain. Feedback
would be much appreciated!


[-- Attachment #2: user-services.scm --]
[-- Type: application/octet-stream, Size: 5217 bytes --]

(use-modules (srfi srfi-1)
             (gnu packages)
             (gnu packages emacs)
             (gnu packages xdisorg)
             (gnu services shepherd)
             (guix build-system trivial)
             (guix gexp)
             (guix monads)
             (guix packages)
             (guix store)
             (guix profiles))

;; a user writes services like this
(define emacs-service
  (shepherd-service
   (provision '(emacs))
   (modules `((gnu packages emacs)
              ,@%default-modules))
   (start #~(make-forkexec-constructor
             (list (string-append #$emacs "/bin/emacs")
                   ;;#;"--daemon"
                   ;; Why not --daemon? That causes emacs to fork and
                   ;; exit, so shepherd tries to restart it.
                   "--eval" "(server-start)"
                   ;; also doesn't work. spawns a window.
                   )))))

;; Based on Mathieu's service
(define redshift-service
  (shepherd-service
   (provision '(redshift))
   (modules `((gnu packages xdisorg)
              ,@%default-modules))
   ;; Why doesn't a with-imported-modules work here?
   (start #~(make-forkexec-constructor
             (list (string-append #$redshift "/bin/redshift")
                   "-l" "50:4")))))

;; the next two are copied from (gnu services shepherd) because:

;; * (gnu services shepherd)'s version of shepherd-configuration-file
;; is for the pid1 shepherd and has some stuff like fallback-to-REPL
;; that is not necessary for user services.

;; * (gnu services shepherd) doesn't export
;; shepherd-configuration-file.
(define (shepherd-service-file service)
  "Return a file defining SERVICE."
  (scheme-file
   "shepherd-service.scm"
   (with-imported-modules
    '((guix build utils)
      (guix build syscalls))
    #~(begin
        (use-modules #$@(shepherd-service-modules service))
        (make <service>
          #:docstring '#$(shepherd-service-documentation service)
          #:provides '#$(shepherd-service-provision service)
          #:requires '#$(shepherd-service-requirement service)
          #:respawn? '#$(shepherd-service-respawn? service)
          #:start #$(shepherd-service-start service)
          #:stop #$(shepherd-service-stop service))))))
(define (shepherd-configuration-file services)
  "Return the shepherd configuration file for SERVICES."
  ;; also not exported. Don't make a circular dependency.
  ;;(assert-valid-graph services)
  (define files (map shepherd-service-file services))
  (define config
    #~(begin
        (use-modules (srfi srfi-34))
        (apply register-services (map primitive-load '#$files))
        (for-each (lambda (service)
                    ;; In the Shepherd 0.3 the 'start' method can raise
                    ;; '&action-runtime-error' if it fails, so protect
                    ;; against it.  (XXX: 'action-runtime-error?' is not
                    ;; exported is 0.3, hence 'service-error?'.)
                    (guard (c ((service-error? c)
                               (format (current-error-port)
                                       "failed to start service '~a'~%"
                                       service)))
                      (start service)))
                  '#$(append-map shepherd-service-provision
                                 (filter shepherd-service-auto-start?
                                         services)))))
  (scheme-file "shepherd.conf" config))

(define (services->package services)
  "Yield a package for SERVICES by making them into a shepherd
configuration file via scheme-file."
  (package
   (name "shepherd-services")
   (version "0")
   (source (shepherd-configuration-file services))
   (build-system trivial-build-system)
   (arguments
     `(#:modules ((guix build utils))
       #:builder
       (begin
         (use-modules (guix build utils))
         (let ((install-directory (string-append %output "/etc/shepherd/")))
           (mkdir-p install-directory)
           (copy-file (assoc-ref %build-inputs "source")
                      (string-append install-directory "init.scm"))))))
   (synopsis "Package closing over Shepherd services.")
   (description (format #f "Contains services ~a"
                        (map shepherd-service-provision services)))
   (license #f
            ;; FIXME: should the licenses be the union of the services
            ;; closed over? What's the liccense of auto-generated code
            ;; anyway?
            )
   (home-page #f)))

(define manifest
  (packages->manifest
   (cons*
    (services->package (list redshift-service))
    (map
     specification->package
     '("emacs"                          ; emacs and supporting
                                        ; packages
       "magit"
       "emacs-guix"
       "emacs-debbugs"
       "emacs-evil"
       "geiser"
       "emacs-paredit"
       "emacs-erc-hl-nicks"
       "emacs-helm"
       "emacs-elfeed"
       "emacs-auctex"
       "emacs-pdf-tools"
       "emacs-tuareg"
       "emacs-org"
       "font-inconsolata"             ; preferred monospace font

       ;; other development
       "git"
       "openssh"                      ; for the client
       "stow"

       "icecat")))))

manifest