[bug#33265] [WIP RFC v4] services: Add file system monitoring service.

[Danny Milosavljevic]

* gnu/services/monitoring.scm (file-system-monitoring-configuration): New
variable.
(file-system-monitoring-entry): 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 | 79 +++++++++++++++++++++++++++++-
 gnu/tests/monitoring.scm    | 97 ++++++++++++++++++++++++++++++++++++-
 3 files changed, 211 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
 
address@hidden file system monitoring
address@hidden 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.
+
address@hidden {Scheme Variable} file-system-monitoring-service-type
+The service type for @command{fswatch}, which provides the file system
+monitoring capability.
+
address@hidden
+(service file-system-monitoring-service-type
+ (file-system-monitoring-configuration
+   (monitored-files '("/foo/bar"))
+   (handlers '((lambda args
+                 (display "UH OH\n"))))))
address@hidden example
address@hidden defvr
+
address@hidden {Data Type} file-system-monitoring-configuration
+The data type representing the configuration of the file-system-monitoring
+service.
+
address@hidden @asis
address@hidden @code{package}
+Package containing the actual file system monitor (fswatch).
+
address@hidden @code{monitored-files}
+List of files to be monitored.
+
address@hidden @code{handlers}
+List of thunks which will be called once the file system monitor noticed
+changes in the monitored files.
+
address@hidden table
address@hidden deftp
+
 @node Setuid Programs
 @subsection Setuid Programs
 
diff --git a/gnu/services/monitoring.scm b/gnu/services/monitoring.scm
index aa3b63a0e..a717175c0 100644
--- a/gnu/services/monitoring.scm
+++ b/gnu/services/monitoring.scm
@@ -26,10 +26,14 @@
   #: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-entry
+            file-system-monitoring-service-type))
 
 
 ;;;
@@ -125,3 +129,76 @@ prometheus.")
     (list (service-extension
            shepherd-root-service-type
            (compose list prometheus-node-exporter-shepherd-service))))))
+
+
+;;;
+;;; File System Monitoring
+;;;
+
+(define-record-type* <file-system-monitoring-entry>
+  file-system-monitoring-entry make-file-system-monitoring-entry
+  file-system-monitoring-entry?
+  (file-name file-system-monitoring-entry-file-name)
+  (handler file-system-monitoring-entry-handler))
+
+(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 '()))) ; list of <file-system-monitoring-entry>.
+
+(define file-system-monitoring-shepherd-services
+  (match-lambda
+   (($ <file-system-monitoring-configuration> package monitored-files)
+    (list (shepherd-service
+           (provision '(file-system-monitoring))
+           (documentation "File System Monitor")
+           (requirement '(file-systems))
+           (start #~(let ((handlers
+                           (list #$@(map file-system-monitoring-entry-handler
+                                         monitored-files))))
+                      (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
+                                  (map file-system-monitoring-entry-file-name
+                                       monitored-files)
+                                  '("/does_not_exist")))))))
+            (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-entries)
+                          (let ((monitored-files
+                                 (map file-system-monitoring-entry-file-name
+                                      monitored-entries))
+                                (handlers
+                                 (map file-system-monitoring-entry-handler
+                                      monitored-entries)))
+                            (match config
+                             (($ <file-system-monitoring-configuration>
+                              package initial-monitored-files)
+                              (file-system-monitoring-configuration
+                               (package package)
+                               (monitored-files (append initial-monitored-files
+                                                        monitored-files))))))))
+                (description
+                 "Call all @dfn{handler}s once something happens with one of
+the files monitored, and on overflow.  Can have false positives.  Will also
+call all @dfn{handlers} on startup.")))
diff --git a/gnu/tests/monitoring.scm b/gnu/tests/monitoring.scm
index 3320a19a7..d2b62374d 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))
 
 
 ;;;
@@ -95,3 +97,96 @@
    (description "Connect to a running prometheus-node-exporter server.")
    (value (run-prometheus-node-exporter-server-test
            name %prometheus-node-exporter-os))))
+
+
+;;;
+;;; 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 is running"
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd))
+                (match (start-service 'file-system-monitoring)
+                  (#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)
+                (mkdir-p "/tmp/glasshouse")
+                ;; Now we provide a file change.  The monitor should [restart
+                ;; and thus] call all the handlers again.
+                (call-with-output-file "/tmp/glasshouse/notice_me" identity)
+                (and
+                 (let loop ((i 0))
+                   (if (file-exists? "/tmp/glasshouse_noticed")
+                       #t
+                       (if (>= i 10)
+                           #f
+                           (begin
+                             (sleep 1)
+                             (loop (+ i 1))))))
+                 ; assume (file-exists? "/tmp/notice_me")
+                 (>= (stat:mtime (stat "/tmp/glasshouse_noticed"))
+                     (stat:mtime (stat "/tmp/glasshouse/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
+              (list
+               (file-system-monitoring-entry
+                (file-name "/tmp/glasshouse")
+                (handler '(lambda _
+                            (call-with-output-file "/tmp/glasshouse_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))))