services: dnsmasq: Add stats and reload shepherd actions.

* gnu/services/dns.scm (dnsmasq-service-reload-action): New function.
Implements SIGHUP handling for reloading configurations.
(dnsmasq-service-stats-action): New function. Implements SIGUSR1
handling for dumping statistics.
(dnsmasq-shepherd-service): Use new actions.
* doc/guix.texi: Document new actions with examples.
* gnu/tests/networking.scm (%test-dnsmasq): Add tests to verify the
functionality of new actions.

Change-Id: I31f0eb4b26a582e95f7bfdb240110c139f0e16cc
Signed-off-by: Maxim Cournoyer <maxim.cournoyer@gmail.com>
Modified-by: Maxim Cournoyer <maxim.cournoyer@gmail.com>

3 files changed, 175 insertions, 0 deletions

diff --git a/doc/guix.texi b/doc/guix.texi
index b3c5c74faf..8e73685a21 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -36111,6 +36111,61 @@ This is the type of the dnsmasq service, whose value should be a
            (no-resolv? #t)
            (servers '("192.168.1.1"))))
 @end lisp
+
+@code{dnsmasq-service-type} provides two actions:
+
+@table @code
+@item reload
+Send a @code{SIGHUP} signal to @command{dnsmasq} to clear cache and
+reload hosts files which triggers the following actions:
+
+@itemize @bullet
+@item
+Clear the DNS cache
+@item
+Reload @file{/etc/hosts} and @file{/etc/ethers}
+@item
+Reload files specified by @option{--dhcp-hostsfile}, @option{--dhcp-hostsdir},
+@option{--dhcp-optsfile}, @option{--dhcp-optsdir}, @option{--addn-hosts},
+or @option{--hostsdir}
+@item
+Execute DHCP lease change scripts for all existing leases
+@item
+Reread @file{/etc/resolv.conf} (only if @option{--no-poll} is
+configured).
+@end itemize
+
+@quotation Note
+The @code{SIGHUP} signal does not trigger a reload of the main
+configuration file.
+@end quotation
+
+Example usage:
+@example
+herd reload dnsmasq
+@end example
+
+@item stats
+When @command{dnsmasq} receives a @code{SIGUSR1} signal, it writes
+statistics to the system log including:
+
+@itemize @bullet
+@item
+Cache size and number of evicted entries
+@item
+Cache hits, misses, and authoritative queries answered
+@item
+For each upstream server: queries sent and errors received
+@item
+TCP connection fork statistics.
+@end itemize
+
+Example usage:
+@example
+herd stats dnsmasq
+@end example
+@end table
+
 @end defvar
 
 @deftp {Data Type} dnsmasq-configuration
diff --git a/gnu/services/dns.scm b/gnu/services/dns.scm
index d55ee3e4fc..9a9b78d877 100644
--- a/gnu/services/dns.scm
+++ b/gnu/services/dns.scm
@@ -874,6 +874,8 @@ cache.size = 100 * MB
      (provision (or provision shepherd-provision))
      (requirement shepherd-requirement)
      (documentation "Run the dnsmasq DNS server.")
+     (actions (list (dnsmasq-service-reload-action config)
+                    (dnsmasq-service-stats-action config)))
      (start #~(make-forkexec-constructor
                (list
                 #$(file-append package "/sbin/dnsmasq")
@@ -965,6 +967,26 @@ cache.size = 100 * MB
       ;; create directory to store dnsmasq lease file
       (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)))))))
+
+(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)))))))
+
 (define dnsmasq-service-type
   (service-type
    (name 'dnsmasq)
diff --git a/gnu/tests/networking.scm b/gnu/tests/networking.scm
index 7d54ebba50..25f61034c6 100644
--- a/gnu/tests/networking.scm
+++ b/gnu/tests/networking.scm
@@ -27,6 +27,7 @@
   #:use-module (gnu system vm)
   #:use-module (gnu services)
   #:use-module (gnu services base)
+  #:use-module (gnu services dns)
   #:use-module (gnu services networking)
   #:use-module (guix gexp)
   #:use-module (guix store)
@@ -46,6 +47,7 @@
             %test-openvswitch
             %test-dhcpd
             %test-dhcpcd
+            %test-dnsmasq
             %test-tor
             %test-iptables
             %test-ipfs))
@@ -675,6 +677,102 @@ subnet 192.168.1.0 netmask 255.255.255.0 {
    (description "Test a running DHCP daemon configuration.")
    (value (run-dhcpd-test))))
 
+
+
+;;;
+;;; dnsmasq tests.
+;;;
+
+
+(define dnsmasq-os-configuration
+  (dnsmasq-configuration))
+
+(define %dnsmasq-os
+  (simple-operating-system
+   (service dhcp-client-service-type)
+   (service dnsmasq-service-type
+            (dnsmasq-configuration
+             (extra-options
+              (list "--log-facility=/tmp/dnsmasq.log"))))))
+
+
+(define (run-dnsmasq-test)
+  (define os
+    (marionette-operating-system %dnsmasq-os
+                                 #:imported-modules '((gnu services herd))))
+
+  (define test
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (gnu build marionette)
+                       (srfi srfi-64))
+
+          (define marionette
+            (make-marionette (list #$(virtual-machine os))))
+
+          (test-runner-current (system-test-runner #$output))
+          (test-begin "dnsmasq")
+
+          (test-assert "dnsmasq is alive"
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd))
+                (wait-for-service 'dnsmasq))
+             marionette))
+
+          (test-assert "pid file exists"
+            (wait-for-file
+             '#$(dnsmasq-configuration-pid-file dnsmasq-os-configuration)
+             marionette))
+
+          (test-assert "send SIGHUP"
+            (positive?
+             (marionette-eval
+              '(begin
+                 (use-modules (ice-9 rdelim))
+                 (system* "sync")
+                 (let* ((port (open-input-file "/tmp/dnsmasq.log")))
+                   (seek port 0 SEEK_END)
+                   (system* "herd" "reload" "dnsmasq")
+                   (system* "sync")
+                   (let ((line (read-line port)))
+                     (close-port port)
+                     (string-contains line "read /etc/hosts"))))
+              marionette)))
+
+          (test-assert "send SIGUSR1"
+            (positive?
+             (marionette-eval
+              '(begin
+                 (use-modules (ice-9 rdelim))
+                 (system* "sync")
+                 (let* ((port (open-input-file "/tmp/dnsmasq.log")))
+                   (seek port 0 SEEK_END)
+                   (system* "herd" "stats" "dnsmasq")
+                   (system* "sync")
+                   (let ((line (read-line port)))
+                     (close-port port)
+                     (string-contains-ci line "time"))))
+              marionette)))
+
+          (test-assert "dnsmasq is alive"
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd))
+                (wait-for-service 'dnsmasq))
+             marionette))
+
+          (test-end))))
+
+  (gexp->derivation "dnsmasq-test" test))
+
+(define %test-dnsmasq
+  (system-test
+   (name "dnsmasq")
+   (description "Test a running dnsmasq daemon configuration.")
+   (value (run-dnsmasq-test))))
+
+
 
 ;;;
 ;;; DHCPCD Daemon