03/05: hydra: berlin: Periodically populate Disarchive database from Cuirass.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository maintenance.

commit 27dc74fbe33a9d929b37994e825dc202385f87c0
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Thu Oct 14 11:36:55 2021 +0200

    hydra: berlin: Periodically populate Disarchive database from Cuirass.
    
    * hydra/modules/sysadmin/services.scm (<disarchive-configuration>): New
    record type.
    (disarchive-activation, disarchive-mcron-jobs): New procedures.
    (disarchive-service-type): New variable.
    * hydra/berlin.scm <services>: Use it.
---
 hydra/berlin.scm                    |  8 +++++
 hydra/modules/sysadmin/services.scm | 69 +++++++++++++++++++++++++++++++++++++
 2 files changed, 77 insertions(+)

diff --git a/hydra/berlin.scm b/hydra/berlin.scm
index 146173b..d89cd4c 100644
--- a/hydra/berlin.scm
+++ b/hydra/berlin.scm
@@ -239,6 +239,14 @@ Happy hacking!\n"))
              (service avahi-service-type
                       (avahi-configuration (debug? #t)))
 
+             ;; Periodically populate the Disarchive database.  Store it
+             ;; under /gnu, which is the big drive; talk directly to the
+             ;; local Cuirass instance.
+             (service disarchive-service-type
+                      (disarchive-configuration
+                       (directory "/gnu/disarchive")
+                       (cuirass-url "http://localhost:8081";)))
+
              ;; DNS
              (service knot-service-type
                       (knot-configuration
diff --git a/hydra/modules/sysadmin/services.scm 
b/hydra/modules/sysadmin/services.scm
index 87e8582..6156855 100644
--- a/hydra/modules/sysadmin/services.scm
+++ b/hydra/modules/sysadmin/services.scm
@@ -20,6 +20,7 @@
   #:use-module (guix gexp)
   #:use-module (guix git-download)
   #:use-module (guix modules)
+  #:use-module (guix records)
   #:use-module ((guix self) #:select (make-config.scm))
   #:use-module ((guix store) #:select (%store-prefix))
   #:use-module (gnu services)
@@ -51,6 +52,8 @@
             cuirass-service
             frontend-services
             KiB MiB GiB TiB
+            disarchive-configuration
+            disarchive-service-type
             goggles-service-type))
 
 (define not-config?
@@ -398,6 +401,72 @@
 
 
 ;;;
+;;; Populating the Disarchive database.
+;;;
+
+(define-record-type* <disarchive-configuration>
+  disarchive-configuration make-disarchive-configuration
+  disarchive-configuration?
+  (cuirass-url   disarchive-configuration-cuirass-url
+                 (default "https://ci.guix.gnu.org";))
+  (directory     disarchive-configuration-directory
+                 (default "/var/cache/disarchive")))
+
+(define disarchive-accounts
+  ;; Account under which the Disarchive mcron job runs.
+  (list (user-account
+         (name "disarchive")
+         (group "disarchive")
+         (home-directory "/var/empty")
+         (create-home-directory? #f)
+         (shell (file-append shadow "/sbin/nologin"))
+         (comment "The Disarchive database user.")
+         (system? #t))
+        (user-group
+         (name "disarchive")
+         (system? #t))))
+
+(define (disarchive-activation config)
+  "Create the directory where the Disarchive database is to be stored."
+  (let ((directory (disarchive-configuration-directory config)))
+    (with-imported-modules '((guix build utils))
+      #~(begin
+          (use-modules (guix build utils))
+          (mkdir-p #$directory)
+          (let ((pw (getpw "disarchive")))
+            (chown #$directory
+                   (passwd:uid pw) (passwd:gid pw)))))))
+
+(define (disarchive-mcron-jobs config)
+  (define program
+    ;; Run 'sync-disarchive-db.scm'; the version of Guix used here doesn't
+    ;; matter since only core interfaces are used.
+    (program-file "populate-disarchive-database"
+                  #~(system* #$(file-append guix "/bin/guix")
+                             "repl" "--"
+                             #$(local-file "../../sync-disarchive-db.scm")
+                             #$(disarchive-configuration-directory config)
+                             #$(disarchive-configuration-cuirass-url config))))
+
+  (list #~(job '(next-hour '(23)) #$program
+               #:user "disarchive")))
+
+(define disarchive-service-type
+  (service-type
+   (name 'disarchive)
+   (extensions (list (service-extension mcron-service-type
+                                        disarchive-mcron-jobs)
+                     (service-extension activation-service-type
+                                        disarchive-activation)
+                     (service-extension account-service-type
+                                        (const disarchive-accounts))))
+   (description
+    "Periodically copy the latest Disarchive metadata obtained from Cuirass
+to a selected directory.")
+   (default-value (disarchive-configuration))))
+
+
+;;;
 ;;; NGINX.
 ;;;