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

Message ID 20181105031833.7917-1-dannym@scratchpost.org
State New
Headers show
Series
  • [bug#33265,WIP,RFC] services: Add file system monitor service.
Related show

Checks

Context Check Description
cbaines/applying patch success Successfully applied

Commit Message

Danny Milosavljevic Nov. 5, 2018, 3:18 a.m. UTC
* 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 | 65 +++++++++++++++++++++++++-
 gnu/tests/monitoring.scm    | 92 ++++++++++++++++++++++++++++++++++++-
 3 files changed, 192 insertions(+), 2 deletions(-)

Comments

Clément Lassieur Nov. 5, 2018, 9:36 a.m. UTC | #1
Hi Danny,

I don't have time to do a proper review, but just one comment:

Danny Milosavljevic <dannym@scratchpost.org> writes:

> +          (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))

How is that better than:

    (test-assert "file system monitor running"
      (marionette-eval
       '(begin
         (use-modules (gnu services herd))
         (start-service 'monitor-file-system))
       marionette))

'start-service' should return #f if the service fails to start.

Cheers,
Clément
Danny Milosavljevic Nov. 11, 2018, 12:15 a.m. UTC | #2
Hi Clément,

On Mon, 05 Nov 2018 10:36:00 +0100
Clément Lassieur <clement@lassieur.org> wrote:

> Danny Milosavljevic <dannym@scratchpost.org> writes:
> 
> > +          (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))  
> 
> How is that better than:

It's not!  Replaced.  Thanks.

Patch

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..94320c7d2 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))
 
 
 ;;;
@@ -125,3 +128,63 @@  prometheus.")
     (list (service-extension
            shepherd-root-service-type
            (compose list prometheus-node-exporter-shepherd-service))))))
+
+
+;;;
+;;; 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)
+                          (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..95fbc7906 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,91 @@ 
    (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)))
+
+  (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))))