02/02: hydra: berlin: Define and use 'disk-space-watchdog-service-type'.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository maintenance.

commit 7fbe51143d268aa8bf316be07d137d9fd75ca95e
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Thu Sep 3 23:16:05 2020 +0200

    hydra: berlin: Define and use 'disk-space-watchdog-service-type'.
    
    * hydra/modules/sysadmin/services.scm (disk-space-check)
    (disk-space-mcron-jobs, disk-space-watchdog-service-type): New
    variables.
    * hydra/berlin.scm <services>: Use it.
---
 hydra/berlin.scm                    |  4 ++++
 hydra/modules/sysadmin/services.scm | 38 +++++++++++++++++++++++++++++++++++++
 2 files changed, 42 insertions(+)

diff --git a/hydra/berlin.scm b/hydra/berlin.scm
index fee6671..b1fef06 100644
--- a/hydra/berlin.scm
+++ b/hydra/berlin.scm
@@ -325,6 +325,10 @@ Happy hacking!\n"))
              ;; For the Mumi mailer queue
              (service redis-service-type)
 
+             ;; Stop Cuirass when disk space is low.
+             (service disk-space-watchdog-service-type
+                      (list (* 500 GiB) (* 50 GiB)))
+
              (frontend-services %sysadmins
                                 #:gc-threshold (* 3 TiB)
                                 #:systems '("x86_64-linux" "i686-linux"
diff --git a/hydra/modules/sysadmin/services.scm 
b/hydra/modules/sysadmin/services.scm
index a6b2932..b33e6aa 100644
--- a/hydra/modules/sysadmin/services.scm
+++ b/hydra/modules/sysadmin/services.scm
@@ -20,6 +20,7 @@
   #:use-module (guix gexp)
   #:use-module (guix modules)
   #:use-module ((guix self) #:select (make-config.scm))
+  #:use-module ((guix store) #:select (%store-prefix))
   #:use-module (gnu services)
   #:use-module (gnu services admin)
   #:use-module (gnu services base)
@@ -44,6 +45,7 @@
   #:use-module (srfi srfi-1)
   #:use-module (ice-9 match)
   #:export (firewall-service
+            disk-space-watchdog-service-type
             frontend-services
             KiB MiB GiB TiB
             goggles-service-type))
@@ -310,6 +312,42 @@
 
 
 ;;;
+;;; Disk space watchdog.
+;;;
+
+(define disk-space-check
+  ;; Check disk space on the store and on the root file system; stop the
+  ;; 'cuirass' service if disk space is too low.
+  (match-lambda
+    ((low-store low-root)
+     (program-file "check-disk-space"
+                   (with-imported-modules (source-module-closure
+                                           '((gnu services herd)
+                                             (guix build syscalls)))
+                     #~(begin
+                         (use-modules (gnu services herd)
+                                      (guix build syscalls))
+
+                         (when (or (< (free-disk-space #$(%store-prefix))
+                                      #$low-store)
+                                   (< (free-disk-space "/")
+                                      #$low-root))
+                           (format #t "Low disk space, stopping Cuirass!~%")
+                           (stop-service 'cuirass))))))))
+
+(define (disk-space-mcron-jobs thresholds)
+  (list #~(job '(next-hour)
+               #$(disk-space-check thresholds))))
+
+(define disk-space-watchdog-service-type
+  (service-type (name 'disk-space-watchdog)
+                (extensions
+                 (list (service-extension mcron-service-type
+                                          disk-space-mcron-jobs)))
+                (description "Stop Cuirass when disk space is too low.")))
+
+
+;;;
 ;;; NGINX.
 ;;;