[bug#33265] [WIP RFC v2] services: Add file system monitor service.

[Danny Milosavljevic <dannym@scratchpost.org>]

* gnu/services/monitoring.scm (file-system-monitoring-configuration): New
variable.
(file-system-monitoring-service-type): New variable.
* gnu/tests/monitoring.scm (%test-file-system-monitoring): New variable.
* doc/guix.texi (File System Monitoring Service): New subsubsection.
---
 doc/guix.texi               | 37 +++++++++++++++
 gnu/services/monitoring.scm | 67 +++++++++++++++++++++++++-
 gnu/tests/monitoring.scm    | 93 ++++++++++++++++++++++++++++++++++++-
 3 files changed, 195 insertions(+), 2 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 3b7fa50d8..8997a0915 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -21496,6 +21496,43 @@ The following is an example @code{dicod-service} configuration.
                     %dicod-database:gcide))))
 @end example
 
+@cindex file system monitoring
+@subsubheading File System Monitoring Service
+
+The @code{(gnu services monitoring)} module provides a shepherd service to
+monitor file system changes and call a handler procedure on changes.
+
+@defvr {Scheme Variable} file-system-monitoring-service-type
+The service type for @command{fswatch}, which provides the file system
+monitoring capability.
+
+@example
+(service file-system-monitoring-service-type
+ (file-system-monitoring-configuration
+   (monitored-files '("/foo/bar"))
+   (handlers '((lambda args
+                 (display "UH OH\n"))))))
+@end example
+@end defvr
+
+@deftp {Data Type} file-system-monitoring-configuration
+The data type representing the configuration of the file-system-monitoring
+service.
+
+@table @asis
+@item @code{package}
+Package containing the actual file system monitor (fswatch).
+
+@item @code{monitored-files}
+List of files to be monitored.
+
+@item @code{handlers}
+List of thunks which will be called once the file system monitor noticed
+changes in the monitored files.
+
+@end table
+@end deftp
+
 @node Setuid Programs
 @subsection Setuid Programs
 
diff --git a/gnu/services/monitoring.scm b/gnu/services/monitoring.scm
index aa3b63a0e..b4bec5648 100644
--- a/gnu/services/monitoring.scm
+++ b/gnu/services/monitoring.scm
@@ -26,10 +26,13 @@
   #:use-module (guix gexp)
   #:use-module (guix records)
   #:use-module (ice-9 match)
+  #:use-module (srfi srfi-1)
   #:export (darkstat-configuration
             prometheus-node-exporter-configuration
             darkstat-service-type
-            prometheus-node-exporter-service-type))
+            prometheus-node-exporter-service-type
+            file-system-monitoring-configuration
+            file-system-monitoring-service-type))
 
 \f
 ;;;
@@ -125,3 +128,65 @@ prometheus.")
     (list (service-extension
            shepherd-root-service-type
            (compose list prometheus-node-exporter-shepherd-service))))))
+
+\f
+;;;
+;;; File System Monitoring
+;;;
+
+(define-record-type* <file-system-monitoring-configuration>
+  file-system-monitoring-configuration
+  make-file-system-monitoring-configuration
+  file-system-monitoring-configuration?
+  (package file-system-monitoring-configuration-package
+           (default fswatch))
+  (monitored-files file-system-monitoring-configuration-monitored-files
+                   (default '()))
+  ;; Note: These thunks are called in the shepherd environment.
+  (handlers file-system-monitoring-configuration-handlers
+            (default '())))
+
+(define file-system-monitoring-shepherd-services
+  (match-lambda
+   (($ <file-system-monitoring-configuration> package monitored-files handlers)
+    (list (shepherd-service
+           (provision '(file-system-monitoring))
+           (documentation "File System Monitor")
+           (requirement '(file-systems))
+           (start #~(lambda ()
+                      (sleep 1)
+                      (for-each (lambda (handler)
+                                  (handler))
+                                handlers)
+                      (fork+exec-command
+                       `(#$(file-append package "/bin/fswatch")
+                         "--one-event"
+                         "-l" "1" ; latency: 1 s
+                         ; "-d"
+                         "--"
+                         #$@(if monitored-files
+                                monitored-files
+                                '())))))
+            (stop #~(make-kill-destructor))
+            (respawn? #t))))))
+
+(define file-system-monitoring-service-type
+  (service-type (name 'monitor-file-system)
+                (extensions
+                 (list (service-extension shepherd-root-service-type
+                                          file-system-monitoring-shepherd-services)))
+                (compose concatenate)
+                (extend (lambda (config monitored-files-handlers)
+                          (let ((monitored-files (map car monitored-files-handlers))
+                                (handlers (map cdr monitored-files-handlers)))
+                            (match config
+                             (($ <file-system-monitoring-configuration> package initial-monitored-files initial-handlers)
+                              (file-system-monitoring-configuration
+                               (package package)
+                               (monitored-files (append initial-monitored-files monitored-files))
+                               (handlers (append initial-handlers handlers))
+))))))
+                (description
+                 "Call all @dfn{handlers} once something happens with one of
+the files monitored, and on overflow.  Can have false positives.  Will call
+all @dfn{handlers} on startup.")))
diff --git a/gnu/tests/monitoring.scm b/gnu/tests/monitoring.scm
index 3320a19a7..46364f830 100644
--- a/gnu/tests/monitoring.scm
+++ b/gnu/tests/monitoring.scm
@@ -20,10 +20,12 @@
   #:use-module (gnu services)
   #:use-module (gnu services monitoring)
   #:use-module (gnu services networking)
+  ;#:use-module (gnu system)
   #:use-module (gnu system vm)
   #:use-module (gnu tests)
   #:use-module (guix gexp)
-  #:export (%test-prometheus-node-exporter))
+  #:export (%test-prometheus-node-exporter
+            %test-file-system-monitoring))
 
 \f
 ;;;
@@ -95,3 +97,92 @@
    (description "Connect to a running prometheus-node-exporter server.")
    (value (run-prometheus-node-exporter-server-test
            name %prometheus-node-exporter-os))))
+
+\f
+;;;
+;;; File System Monitoring.
+;;;
+
+(define* (run-file-system-monitoring-test name test-os)
+  "Run tests in TEST-OS, which has file system monitoring running."
+  (define os
+    (marionette-operating-system
+     test-os
+     #:imported-modules '((gnu services herd))))
+
+  (define vm
+    (virtual-machine
+     (operating-system os)
+     (port-forwardings '())))
+
+  (define test
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (srfi srfi-11)
+                       (srfi srfi-64)
+                       (gnu build marionette)
+                       (web client)
+                       (web response))
+
+          (define marionette
+            (make-marionette (list #$vm)))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin #$name)
+
+          (test-assert "file system monitor running"
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd))
+                (match (start-service 'monitor-file-system)
+                  (#f #f)
+                  (('service response-parts ...)
+                   (match (assq-ref response-parts 'running)
+                     ((pid) (number? pid))))))
+             marionette))
+
+          (test-assert "file system monitor notices file system change"
+            (marionette-eval
+             '(begin
+                ;; Not strictly necessary - but we want to test the actual
+                ;; fswatch invocation and not our own synthetic events, so
+                ;; give fswatch the chance to start up.
+                (sleep 2)
+                ;; Now we provide a file change.  The monitor should [restart
+                ;; and thus] call all the handlers again.
+                (call-with-output-file "/tmp/notice_me" identity)
+                (and
+                 (let loop ((i 0))
+                   (if (file-exists? "/tmp/noticed")
+                       #t
+                       (if (>= i 10)
+                           #f
+                           (begin
+                             (sleep 1)
+                             (loop (+ i 1))))))
+                 ; assume (file-exists? "/tmp/notice_me")
+                 (>= (stat:mtime (stat "/tmp/noticed"))
+                     (stat:mtime (stat "/tmp/notice_me")))))
+             marionette))
+          (test-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation (string-append name "-test") test))
+
+(define %file-system-monitoring-os
+  (simple-operating-system
+   (service file-system-monitoring-service-type
+            (file-system-monitoring-configuration
+             (monitored-files '("/tmp/notice_me"))
+             (handlers '(lambda args
+                          (call-with-output-file "/tmp/noticed"
+                            identity)))))))
+
+(define %test-file-system-monitoring
+  (system-test
+   (name "file-system-monitoring")
+   (description "Test file system monitoring event handler.")
+   (value (run-file-system-monitoring-test
+           name %file-system-monitoring-os))))