01/11: services: shepherd: Support custom actions.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 701383081a9814d21823d42978ae23ee654e0427
Author: Ludovic Courtès <address@hidden>
Date:   Wed Jul 11 23:17:37 2018 +0200

    services: shepherd: Support custom actions.
    
    * gnu/services/shepherd.scm (<shepherd-service>)[actions]: New field.
    (<shepherd-action>): New record type.
    (shepherd-service-file): Pass #:actions to 'make'.
    * doc/guix.texi (Shepherd Services): Document custom actions.
---
 doc/guix.texi             | 59 +++++++++++++++++++++++++++++++++++++++++++++++
 gnu/services/shepherd.scm | 23 +++++++++++++++++-
 2 files changed, 81 insertions(+), 1 deletion(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 8b286e9..34012a3 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -21969,6 +21969,17 @@ Constructors,,, shepherd, The GNU Shepherd Manual}).  
They are given as
 G-expressions that get expanded in the Shepherd configuration file
 (@pxref{G-Expressions}).
 
address@hidden @code{actions} (default: @code{'()})
address@hidden actions, of Shepherd services
+This is a list of @code{shepherd-action} objects (see below) defining
address@hidden supported by the service, in addition to the standard
address@hidden and @code{stop} actions.  Actions listed here become available as
address@hidden sub-commands:
+
address@hidden
+herd @var{action} @var{service} address@hidden@dots{}]
address@hidden example
+
 @item @code{documentation}
 A documentation string, as shown when running:
 
@@ -21986,6 +21997,54 @@ This is the list of modules that must be in scope when 
@code{start} and
 @end table
 @end deftp
 
address@hidden {Data Type} shepherd-action
+This is the data type that defines additional actions implemented by a
+Shepherd service (see above).
+
address@hidden @code
address@hidden name
+Symbol naming the action.
+
address@hidden documentation
+This is a documentation string for the action.  It can be viewed by running:
+
address@hidden
+herd doc @var{service} action @var{action}
address@hidden example
+
address@hidden procedure
+This should be a gexp that evaluates to a procedure of at least one argument,
+which is the ``running value'' of the service (@pxref{Slots of services,,,
+shepherd, The GNU Shepherd Manual}).
address@hidden table
+
+The following example defines an action called @code{say-hello} that kindly
+greets the user:
+
address@hidden
+(shepherd-action
+  (name 'say-hello)
+  (documentation "Say hi!")
+  (procedure #~(lambda (running . args)
+                 (format #t "Hello, friend! arguments: ~s\n"
+                         args)
+                 #t)))
address@hidden example
+
+Assuming this action is added to the @code{example} service, then you can do:
+
address@hidden
+# herd say-hello example
+Hello, friend! arguments: ()
+# herd say-hello example a b c
+Hello, friend! arguments: ("a" "b" "c")
address@hidden example
+
+This, as you can see, is a fairly sophisticated way to say hello.
address@hidden Convenience,,, shepherd, The GNU Shepherd Manual}, for more
+info on actions.
address@hidden deftp
+
 @defvr {Scheme Variable} shepherd-root-service-type
 The service type for the Shepherd ``root service''---i.e., address@hidden
 
diff --git a/gnu/services/shepherd.scm b/gnu/services/shepherd.scm
index 6ca53fa..4cd2249 100644
--- a/gnu/services/shepherd.scm
+++ b/gnu/services/shepherd.scm
@@ -49,6 +49,12 @@
             shepherd-service-auto-start?
             shepherd-service-modules
 
+            shepherd-action
+            shepherd-action?
+            shepherd-action-name
+            shepherd-action-documentation
+            shepherd-action-procedure
+
             %default-modules
 
             shepherd-service-file
@@ -146,11 +152,20 @@ DEFAULT is given, use it as the service's default value."
   (start         shepherd-service-start)               ;g-expression 
(procedure)
   (stop          shepherd-service-stop                 ;g-expression 
(procedure)
                  (default #~(const #f)))
+  (actions       shepherd-service-actions              ;list of 
<shepherd-action>
+                 (default '()))
   (auto-start?   shepherd-service-auto-start?          ;Boolean
                  (default #t))
   (modules       shepherd-service-modules              ;list of module names
                  (default %default-modules)))
 
+(define-record-type* <shepherd-action>
+  shepherd-action make-shepherd-action
+  shepherd-action?
+  (name          shepherd-action-name)            ;symbol
+  (procedure     shepherd-action-procedure)       ;gexp
+  (documentation shepherd-action-documentation))  ;string
+
 (define (shepherd-service-canonical-name service)
   "Return the 'canonical name' of SERVICE."
   (first (shepherd-service-provision service)))
@@ -223,7 +238,13 @@ stored."
                        #:requires '#$(shepherd-service-requirement service)
                        #:respawn? '#$(shepherd-service-respawn? service)
                        #:start #$(shepherd-service-start service)
-                       #:stop #$(shepherd-service-stop service))))))
+                       #:stop #$(shepherd-service-stop service)
+                       #:actions
+                       (make-actions
+                        #$@(map (match-lambda
+                                  (($ <shepherd-action> name proc doc)
+                                   #~(#$name #$doc #$proc)))
+                                (shepherd-service-actions service))))))))
 
 (define (shepherd-configuration-file services)
   "Return the shepherd configuration file for SERVICES."