diff options
| author | Christopher Baines <mail@cbaines.net> | 2024-06-13 10:30:10 +0100 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2024-06-13 11:01:19 +0100 |
| commit | 15fdb70be5ee73590fa9c122efa4f3bc1cce51b5 (patch) | |
| tree | 470135bdc87127855d7213ede9847fa02ab95b0f | |
| parent | 3028f927261ca602a03edb9e351304fc14555bc9 (diff) | |
| download | nar-herder-15fdb70be5ee73590fa9c122efa4f3bc1cce51b5.tar nar-herder-15fdb70be5ee73590fa9c122efa4f3bc1cce51b5.tar.gz | |
Don't use the recent changes fiber when mirroring
Because this overcomplicates things. Have the fetch changes fiber
trigger actions instead.
| -rw-r--r-- | nar-herder/mirror.scm | 23 | ||||
| -rw-r--r-- | nar-herder/server.scm | 45 |
2 files changed, 45 insertions, 23 deletions
diff --git a/nar-herder/mirror.scm b/nar-herder/mirror.scm index 8aae845..14e23a9 100644 --- a/nar-herder/mirror.scm +++ b/nar-herder/mirror.scm @@ -41,7 +41,11 @@ (define (start-fetch-changes-fiber database metrics-registry storage-root mirror + addition-channel cached-compression-management-channel) + (define recent-changes-count-metric + (metrics-registry-fetch-metric metrics-registry "recent_changes_count")) + (define (request-recent-changes) (define latest-recent-change (database-select-latest-recent-change-datetime database)) @@ -105,6 +109,8 @@ (unless (member (strip-change-datetime change-details) processed-recent-changes) (let ((change (assq-ref change-details 'change))) + (metric-increment recent-changes-count-metric) + (cond ((string=? change "addition") (let ((narinfo @@ -120,10 +126,20 @@ narinfo #:change-datetime (assq-ref change-details - 'datetime)))) + 'datetime)) + + (when addition-channel + (for-each + (lambda (uri) + (spawn-fiber + (lambda () + (put-message addition-channel + `(addition ,(uri-path uri)))))) + (narinfo-uris narinfo))))) ((string=? change "removal") (let ((store-path (assq-ref change-details 'data))) + ;; TODO Use the nar removal fiber (log-msg 'INFO "processing removal change for " store-path " (" (assq-ref change-details 'datetime) ")") @@ -176,6 +192,11 @@ (spawn-fiber (lambda () + (let ((recent-changes-count + (database-count-recent-changes database))) + (metric-set recent-changes-count-metric recent-changes-count) + (log-msg 'DEBUG recent-changes-count " recent changes in the database")) + (while #t (with-exception-handler (lambda (exn) diff --git a/nar-herder/server.scm b/nar-herder/server.scm index 30b8c8d..bedfd17 100644 --- a/nar-herder/server.scm +++ b/nar-herder/server.scm @@ -800,23 +800,13 @@ (assq-ref opts 'recent-changes-limit)) (let ((mirror-channel - (and=> - (assq-ref opts 'mirror) - (lambda (mirror) - (start-fetch-changes-fiber - database - metrics-registry - canonical-storage ; might be #f, but that's fine here - mirror - cached-compression-management-channel) - - (if (assq-ref opts 'storage) - (start-mirroring-fiber database - mirror - (assq-ref opts 'storage-limit) - canonical-storage - metrics-registry) - #f)))) + (and (assq-ref opts 'mirror) + (assq-ref opts 'storage) + (start-mirroring-fiber database + (assq-ref opts 'mirror) + (assq-ref opts 'storage-limit) + canonical-storage + metrics-registry))) (removal-channel (start-nar-removal-fiber database @@ -826,6 +816,15 @@ nar-removal-criteria)) (addition-channel (make-channel))) + (when (assq-ref opts 'mirror) + (start-fetch-changes-fiber + database + metrics-registry + canonical-storage ; might be #f, but that's fine here + (assq-ref opts 'mirror) + addition-channel + cached-compression-management-channel)) + (spawn-fiber (lambda () (while #t @@ -851,6 +850,7 @@ (lambda () (put-message mirror-channel `(fetch ,file))))) + (when (and (assq-ref opts 'storage) (number? (assq-ref opts 'storage-limit)) (not (null? nar-removal-criteria))) @@ -870,11 +870,12 @@ file))))))) #:unwind? #t)))) - (start-recent-change-listener-fiber - database - metrics-registry - addition-channel - removal-channel)) + (unless (assq-ref opts 'mirror) + (start-recent-change-listener-fiber + database + metrics-registry + addition-channel + removal-channel))) (unless (null? enabled-cached-compressions) (let ((cached-compression-removal-fiber-wakeup-channel |