From 62d6af3d480c23b061699705e815fcf76c57d97d Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Sat, 9 Sep 2023 10:42:05 +0100
Subject: Move most maintenance activity to fibers

On a single separate thread. This will allow for spawning fibers for
various maintenance actions.
---
 scripts/nar-herder.in | 83 ++++++++++++++++++++++++++++++---------------------
 1 file changed, 49 insertions(+), 34 deletions(-)

(limited to 'scripts')

diff --git a/scripts/nar-herder.in b/scripts/nar-herder.in
index 59df42e..ac3002b 100644
--- a/scripts/nar-herder.in
+++ b/scripts/nar-herder.in
@@ -39,6 +39,7 @@
              (ice-9 ftw)
              (ice-9 match)
              (ice-9 format)
+             (ice-9 threads)
              (ice-9 suspendable-ports)
              (web uri)
              (web client)
@@ -57,6 +58,7 @@
              (guix derivations)
              ((guix store) #:select (store-path-hash-part))
              ((guix build utils) #:select (dump-port))
+             ((guix build syscalls) #:select (set-thread-name))
              (nar-herder utils)
              (nar-herder database)
              (nar-herder recent-changes)
@@ -614,46 +616,59 @@
         (* 24 3600)                     ; 24 hours
         (assq-ref opts 'recent-changes-limit))
 
-       (and=> (assq-ref opts 'mirror)
-              (lambda (mirror)
-                (start-fetch-changes-thread database
+       (let ((finished? (make-condition)))
+         (call-with-new-thread
+          (lambda ()
+            (catch 'system-error
+              (lambda ()
+                (set-thread-name "maintenance"))
+              (const #t))
+
+            (run-fibers
+             (lambda ()
+               (and=> (assq-ref opts 'mirror)
+                      (lambda (mirror)
+                        (start-fetch-changes-fiber database
+                                                   canonical-storage
+                                                   mirror
+                                                   metrics-registry)
+
+                        (when (assq-ref opts 'storage)
+                          (start-mirroring-fiber database
+                                                 mirror
+                                                 (assq-ref opts 'storage-limit)
+                                                 canonical-storage
+                                                 metrics-registry))))
+
+
+               (let ((nar-removal-criteria
+                      (filter-map
+                       (match-lambda
+                         ((key . val)
+                          (if (eq? key 'storage-nar-removal-criteria)
+                              val
+                              #f)))
+                       opts)))
+                 (when (and (assq-ref opts 'storage)
+                            (number? (assq-ref opts 'storage-limit))
+                            (not (null? nar-removal-criteria)))
+                   (start-nar-removal-fiber database
                                             canonical-storage
-                                            mirror
-                                            metrics-registry)
-
-                (when (assq-ref opts 'storage)
-                  (start-mirroring-thread database
-                                          mirror
-                                          (assq-ref opts 'storage-limit)
-                                          canonical-storage
-                                          metrics-registry))))
-
-
-       (let ((nar-removal-criteria
-              (filter-map
-               (match-lambda
-                 ((key . val)
-                  (if (eq? key 'storage-nar-removal-criteria)
-                      val
-                      #f)))
-               opts)))
-         (when (and (assq-ref opts 'storage)
-                    (number? (assq-ref opts 'storage-limit))
-                    (not (null? nar-removal-criteria)))
-           (start-nar-removal-thread database
-                                     canonical-storage
-                                     (assq-ref opts 'storage-limit)
-                                     metrics-registry
-                                     nar-removal-criteria)))
-
-       (log-msg 'INFO "starting server, listening on "
-                (assq-ref opts 'host) ":" (assq-ref opts 'port))
+                                            (assq-ref opts 'storage-limit)
+                                            metrics-registry
+                                            nar-removal-criteria)))
+
+               (wait finished?))
+             #:hz 0
+             #:parallelism 1)))
 
-       (let ((finished? (make-condition)))
          (call-with-sigint
           (lambda ()
             (run-fibers
              (lambda ()
+               (log-msg 'INFO "starting server, listening on "
+                        (assq-ref opts 'host) ":" (assq-ref opts 'port))
+
                (run-server/patched
                 (make-request-handler database
                                       canonical-storage
-- 
cgit v1.2.3