aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMasaya Tojo <masaya@tojo.tokyo>2021-09-11 21:32:07 +0900
committerMasaya Tojo <masaya@tojo.tokyo>2021-09-11 22:19:16 +0900
commit9dadbd397af96b53b14050e741618657f6d7bf33 (patch)
treee59753571d608bf2bb26ab7253e47b9baeed49b6
parentf78bd2d119a2a57952dd17e6f40859c2ac6b4fb9 (diff)
monitoring: Refactoring.HEADmaster
-rw-r--r--tojo-tokyo/monitoring.scm76
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))