(address . guix-patches@gnu.org)(name . Danny Milosavljevic)(address . dannym@scratchpost.org)
20181105031833.7917-1-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 | 65 +++++++++++++++++++++++++-
gnu/tests/monitoring.scm | 92 ++++++++++++++++++++++++++++++++++++-
3 files changed, 192 insertions(+), 2 deletions(-)
Toggle diff (241 lines)
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))))