diff options
| author | Christopher Baines <mail@cbaines.net> | 2023-09-09 10:42:05 +0100 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2023-09-12 13:11:00 +0100 |
| commit | 62d6af3d480c23b061699705e815fcf76c57d97d (patch) | |
| tree | 883953c7f29c2352244a64ff7897b6fe74520c3b /scripts | |
| parent | 3e0721c759b7d7c491ba4baeae3cf285a84c1f33 (diff) | |
| download | nar-herder-62d6af3d480c23b061699705e815fcf76c57d97d.tar nar-herder-62d6af3d480c23b061699705e815fcf76c57d97d.tar.gz | |
Move most maintenance activity to fibers
On a single separate thread. This will allow for spawning fibers for
various maintenance actions.
Diffstat (limited to 'scripts')
| -rw-r--r-- | scripts/nar-herder.in | 83 |
1 files changed, 49 insertions, 34 deletions
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 |