monitoring: Refactoring.HEADmaster

1 files changed, 37 insertions, 39 deletions

diff --git a/tojo-tokyo/monitoring.scm b/tojo-tokyo/monitoring.scm
index c9e34a1..15159e2 100644
--- a/tojo-tokyo/monitoring.scm
+++ b/tojo-tokyo/monitoring.scm
@@ -21,6 +21,7 @@
   #:use-module (ice-9 textual-ports)
   #:use-module (ice-9 regex)
   #:use-module ((srfi srfi-1) #:select (any))
+  #:use-module ((srfi srfi-26))
   #:use-module (web client))
 
 (define-public current-heartbeat-url
@@ -30,54 +31,51 @@
               (call-with-input-file heartbeat-file get-line))
          "https://heartbeat.test"))))
 
-(define (df)
-  (let ((port (open-input-pipe "df")))
-    (get-line port)
-    (let f ((line (get-line port)))
+(define (split-with-spaces x)
+  (map match:substring (list-matches "[^ ]+" x)))
+
+(define (command->table command header)
+  (let ((port (open-input-pipe command)))
+    (get-line port)                     ; skip a header line.
+    (let loop ((line (get-line port))
+               (table '()))
       (cond ((eof-object? line)
              (close-pipe port)
-             '())
+             table)
             (else
-             (cons (map cons
-                        '(filesystem 1k-blocks used available use% mounted-on)
-                        (map match:substring (list-matches "[^ ]+" line)))
-                   (f (get-line port))))))))
+             (loop (get-line port)
+                   (cons (map cons header (split-with-spaces line))
+                         table)))))))
+
+(define (df)
+  (command->table "df" '(filesystem 1k-blocks used available use% mounted-on)))
+
+(define (prefix-/dev/? x)
+  (and (string? x)
+       (<= 5 (string-length x))
+       (string=? (substring x 0 5) "/dev/")))
+
+(define (use%->number x)
+  (string->number (string-delete #\% x)))
 
 (define-public (disk-use%-over? threshold)
-  (any (lambda (x)
-         (let ((use% (string->number (string-delete #\% (assoc-ref x 'use%)))))
-           (< threshold use%)))
-       (filter (lambda (x)
-                 (let ((fs (assoc-ref x 'filesystem)))
-                   (and fs
-                        (<= 5 (string-length fs))
-                        (string=? (substring fs 0 5) "/dev/"))))
-               (df))))
+  (any (cut < threshold <>)
+       (map (compose use%->number (cut assoc-ref <> 'use%))
+            (filter (compose prefix-/dev/? (cut assoc-ref <> 'filesystem))
+                    (df)))))
 
 (define (df-i)
-  (let ((port (open-input-pipe "df -i")))
-    (get-line port)
-    (let f ((line (get-line port)))
-      (cond ((eof-object? line)
-             (close-pipe port)
-             '())
-            (else
-             (cons (map cons
-                        '(filesystem inodes iused ifree iuse% mounted-on)
-                        (map match:substring (list-matches "[^ ]+" line)))
-                   (f (get-line port))))))))
+  (command->table "df -i" '(filesystem inodes iused ifree iuse% mounted-on)))
+
+(define (iuse%->number x)
+  (or (string->number (string-delete #\% x))
+      0))
 
 (define-public (disk-iuse%-over? threshold)
-  (any (lambda (x)
-         (let ((iuse% (string->number (string-delete #\% (assoc-ref x 'iuse%)))))
-           (and iuse%
-                (< threshold iuse%))))
-       (filter (lambda (x)
-                 (let ((fs (assoc-ref x 'filesystem)))
-                   (and fs
-                        (<= 5 (string-length fs))
-                        (string=? (substring fs 0 5) "/dev/"))))
-               (df-i))))
+  (any (cut < threshold <>)
+       (map (compose iuse%->number (cut assoc-ref <> 'iuse%))
+            (filter (compose prefix-/dev/? (cut assoc-ref <> 'filesystem))
+                    (df-i)))))
 
 (define-syntax-rule (heartbeat (p? body ...) ...)
   (let ((heartbeat-cancel? #f))