services: Add and use shepherd-signal-action.

* gnu/services/shepherd.scm (shepherd-signal-action): New procedure.

* gnu/services/audio.scm (mpd-shepherd-service): Use it for actions.
* gnu/services/base.scm (syslog-shepherd-service):
* gnu/services/base.scm (dnsmasq-shepherd-service):
* gnu/services/file-sharing.scm (transmission-daemon-shepherd-service):
* gnu/services/monitoring.scm (vnstat-shepherd-service):
* gnu/services/mail.scm (rspamd-shepherd-service):

* doc/guix.texi (shepherd-signal-action): Document it.

Change-Id: Ief5e00c7d430ec4aa28c3ef11d0ef9897793b45f
Signed-off-by: Ludovic Courtès <ludo@gnu.org>
Merges: #6097

8 files changed, 77 insertions, 81 deletions

diff --git a/doc/guix.texi b/doc/guix.texi
index b0ab0c1db5b..9924f4771f2 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -50488,6 +50488,29 @@ cat $(herd configuration tor)
 This can come in as a handy debugging tool!
 @end deffn
 
+@deffn {Procedure} shepherd-signal-action name signal @
+[#:documentation `Send signal @var{signal} to the running service`] @
+[#:message `Service has been asked to perform @var{name}`]
+Return a shepherd action with @var{name} to send @var{signal} to the
+running process. The optional @var{documentation} and @var{message} can be used
+to customize the documentation and output message.
+
+Many daemons perform special actions after receiving a specific signal.
+
+For example the @command{syslogd} logger will reread its configuration file
+after receiving @code{SIGHUP}.
+
+After adding
+@lisp
+(shepherd-signal-action 'reload SIGHUP))
+@end lisp
+
+the @code{reload} action will be available and can be used with
+@example
+herd reload syslogd
+@end example
+@end deffn
+
 @defvar shepherd-root-service-type
 The service type for the Shepherd ``root service''---i.e., PID@tie{}1.
 
diff --git a/gnu/services/audio.scm b/gnu/services/audio.scm
index 5091d7fc137..517ed8fc5bf 100644
--- a/gnu/services/audio.scm
+++ b/gnu/services/audio.scm
@@ -636,18 +636,10 @@ appended to the configuration.")
        (stop  #~(make-kill-destructor))
        (actions
         (list (shepherd-configuration-action config-file)
-              (shepherd-action
-               (name 'reopen)
-               (documentation "Re-open log files and flush caches.")
-               (procedure
-                #~(lambda (pid)
-                    (if pid
-                        (begin
-                          (kill pid SIGHUP)
-                          (format #t
-                                  "Issued SIGHUP to Service MPD (PID ~a)."
-                                  pid))
-                        (format #t "Service MPD is not running.")))))))))))
+              (shepherd-signal-action
+               'reopen SIGHUP
+               #:documentation "Re-open log files and flush caches."
+               #:message "Issued SIGHUP to Service MPD.")))))))
 
 (define (mpd-accounts config)
   (match-record config <mpd-configuration> (user group)
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 0ccc6089771..31ae0cb9374 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -1708,17 +1708,11 @@ mail.*                                 -/var/log/maillog
    (requirement '(user-processes))
    (actions
     (list (shepherd-configuration-action syslog.conf)
-          (shepherd-action
-           (name 'reload)
-           (documentation "Reload the configuration file from disk.")
-           (procedure
-            #~(lambda (pid)
-                (if pid
-                    (begin
-                      (kill pid SIGHUP)
-                      (display #$(G_ "Service syslog has been asked to \
+          (shepherd-signal-action
+           'reload SIGHUP
+           #:documentation "Reload the configuration file from disk."
+           #:message "Service syslog has been asked to \
 reload its settings file.")))
-                    (display #$(G_ "Service syslog is not running."))))))))
    ;; Note: a static file name is used for syslog.conf so that the reload
    ;; action work as intended.
    (start #~(make-forkexec-constructor
diff --git a/gnu/services/dns.scm b/gnu/services/dns.scm
index 42a65a27677..e0cab485884 100644
--- a/gnu/services/dns.scm
+++ b/gnu/services/dns.scm
@@ -969,24 +969,16 @@ cache.size = 100 * MB
       (mkdir-p "/var/lib/misc")))
 
 (define (dnsmasq-service-reload-action config)
-  (match-record config <dnsmasq-configuration> ()
-    (shepherd-action
-     (name 'reload)
-     (documentation "Send a @code{SIGHUP} signal to @command{dnsmasq} to clear
-cache and reload hosts files.")
-     (procedure #~(lambda (running)
-                    (let ((pid (process-id running)))
-                      (kill pid SIGHUP)))))))
+  (shepherd-signal-action
+   'reload SIGHUP
+   #:documentation "Send a @code{SIGHUP} signal to @command{dnsmasq} to clear
+cache and reload hosts files."))
 
 (define (dnsmasq-service-stats-action config)
-  (match-record config <dnsmasq-configuration> ()
-    (shepherd-action
-     (name 'stats)
-     (documentation "Send a @code{SIGUSR1} to write statistics to the system
-log.")
-     (procedure #~(lambda (running)
-                    (let ((pid (process-id running)))
-                      (kill pid SIGUSR1)))))))
+  (shepherd-signal-action
+   'stats SIGUSR1
+   #:documentation "Send a @code{SIGUSR1} to write statistics to the system
+log."))
 
 (define dnsmasq-service-type
   (service-type
diff --git a/gnu/services/file-sharing.scm b/gnu/services/file-sharing.scm
index d0e9a8ca901..be4a694cd13 100644
--- a/gnu/services/file-sharing.scm
+++ b/gnu/services/file-sharing.scm
@@ -656,17 +656,11 @@ satisfy requests from peers."))
 
       (actions
        (list
-        (shepherd-action
-         (name 'reload)
-         (documentation "Reload the settings file from disk.")
-         (procedure #~(lambda (pid)
-                        (if pid
-                            (begin
-                              (kill pid SIGHUP)
-                              (display #$(G_ "Service transmission-daemon has \
-been asked to reload its settings file.")))
-                            (display #$(G_ "Service transmission-daemon is not \
-running."))))))))))))
+        (shepherd-signal-action
+         'reload SIGHUP
+         #:documentation "Reload the settings file from disk."
+         #:message "Service transmission-daemon has \
+been asked to reload its settings file.")))))))
 
 (define %transmission-daemon-accounts
   (list (user-group
diff --git a/gnu/services/mail.scm b/gnu/services/mail.scm
index 5d4bc4684d3..70825dd1a9d 100644
--- a/gnu/services/mail.scm
+++ b/gnu/services/mail.scm
@@ -2483,26 +2483,14 @@ worker \"fuzzy\" {
       (actions
        (list
         (shepherd-configuration-action config-file)
-        (shepherd-action
-         (name 'reload)
-         (documentation "Reload rspamd.")
-         (procedure
-          #~(lambda (pid)
-              (if pid
-                (begin
-                  (kill pid SIGHUP)
-                  (display "Service rspamd has been reloaded"))
-                (format #t "Service rspamd is not running.")))))
-        (shepherd-action
-         (name 'reopen)
-         (documentation "Reopen log files.")
-         (procedure
-          #~(lambda (pid)
-              (if pid
-                (begin
-                  (kill pid SIGUSR1)
-                  (display "Reopening the logs for rspamd"))
-                (format #t "Service rspamd is not running.")))))))))))
+        (shepherd-signal-action
+         'reload SIGHUP
+         #:documentation "Reload rspamd."
+         #:message "Service rspamd has been reloaded")
+        (shepherd-signal-action
+         'reopen SIGUSR1
+         #:documentation "Reopen log files."
+         #:message "Reopening the logs for rspamd.")))))))
 
 (define rspamd-service-type
   (service-type
diff --git a/gnu/services/monitoring.scm b/gnu/services/monitoring.scm
index f504c61afdf..8ba19ddd7ee 100644
--- a/gnu/services/monitoring.scm
+++ b/gnu/services/monitoring.scm
@@ -640,18 +640,10 @@ resolution.")
        (stop #~(make-kill-destructor))
        (actions
         (list (shepherd-configuration-action config-file)
-              (shepherd-action
-               (name 'reload)
-               (documentation "Reload vnstatd.")
-               (procedure
-                #~(lambda (pid)
-                    (if pid
-                        (begin
-                          (kill pid SIGHUP)
-                          (format #t
-                                  "Issued SIGHUP to vnstatd (PID ~a)."
-                                  pid))
-                        (format #t "vnstatd is not running.")))))))))))
+              (shepherd-signal-action
+               'reload SIGHUP
+               #:documentation "Reload vnstatd."
+               #:message "Issued SIGHUP to vnstatd.")))))))
 
 (define (vnstat-account-service config)
   (match-record config <vnstat-configuration> (daemon-group daemon-user)
diff --git a/gnu/services/shepherd.scm b/gnu/services/shepherd.scm
index 1c5f6606153..89c8fd3a135 100644
--- a/gnu/services/shepherd.scm
+++ b/gnu/services/shepherd.scm
@@ -71,6 +71,7 @@
             shepherd-action-documentation
             shepherd-action-procedure
 
+            shepherd-signal-action
             shepherd-configuration-action
             shepherd-timer
             shepherd-trigger-action
@@ -421,6 +422,26 @@ and return the resulting '.go' file. SHEPHERD is used as shepherd package."
                      #:options '(#:local-build? #t
                                  #:substitutable? #f)))))
 
+(define* (shepherd-signal-action
+          name signal
+          #:key
+          (documentation (format #f "Send signal ~a to the running service."
+                                 signal))
+          (message (format #f "Service has been asked to perform '~a'."
+                           name)))
+  "Return a shepherd action with NAME to send SIGNAL to the running process.
+The documentation string of the action will be set to DOC.
+The action will print MESSAGE after sending the signal."
+  (shepherd-action
+    (name name)
+    (documentation documentation)
+    (procedure #~(lambda (running . args)
+                   (if running
+                       (let ((pid (process-id running)))
+                         (kill pid #$signal)
+                         (display #$message))
+                       (display "Service is not running."))))))
+
 (define (shepherd-configuration-action file)
   "Return a 'configuration' action to display FILE, which should be the name
 of the service's configuration file."