diff options
| -rw-r--r-- | nar-herder/server.scm | 38 | ||||
| -rw-r--r-- | nar-herder/storage.scm | 26 |
2 files changed, 33 insertions, 31 deletions
diff --git a/nar-herder/server.scm b/nar-herder/server.scm index 7046784..2d28a5f 100644 --- a/nar-herder/server.scm +++ b/nar-herder/server.scm @@ -740,7 +740,16 @@ compression) 'directory))) (utime (string-append directory "/" filename)))) - maintenance-scheduler))))) + maintenance-scheduler)))) + + (nar-removal-criteria + (filter-map + (match-lambda + ((key . val) + (if (eq? key 'storage-nar-removal-criteria) + val + #f))) + opts))) (if (string=? (assq-ref opts 'database-dump) "disabled") @@ -793,23 +802,12 @@ metrics-registry) #f)))) (removal-channel - (let ((nar-removal-criteria - (filter-map - (match-lambda - ((key . val) - (if (eq? key 'storage-nar-removal-criteria) - val - #f))) - opts))) - (if (and (assq-ref opts 'storage) - (number? (assq-ref opts 'storage-limit)) - (not (null? nar-removal-criteria))) - (start-nar-removal-fiber database - canonical-storage - (assq-ref opts 'storage-limit) - metrics-registry - nar-removal-criteria) - #f))) + (start-nar-removal-fiber + database + canonical-storage + (assq-ref opts 'storage-limit) + metrics-registry + nar-removal-criteria)) (addition-channel (make-channel))) (spawn-fiber @@ -837,7 +835,9 @@ (lambda () (put-message mirror-channel `(fetch ,file))))) - (when removal-channel + (when (and (assq-ref opts 'storage) + (number? (assq-ref opts 'storage-limit)) + (not (null? nar-removal-criteria))) (spawn-fiber (lambda () (sleep 60) diff --git a/nar-herder/storage.scm b/nar-herder/storage.scm index e85d745..dc6b365 100644 --- a/nar-herder/storage.scm +++ b/nar-herder/storage.scm @@ -536,23 +536,25 @@ When VERIFY-CERTIFICATE? is true, verify HTTPS server certificates." (log-msg 'ERROR "failed to remove " file ": " exn)) (lambda () ;; TODO: Do more checking at this point - (remove-nar-from-storage - storage-root - (uri-decode file)) + (when storage-root + (remove-nar-from-storage + storage-root + (uri-decode file))) (update-nar-files-metric metrics-registry '() #:removed-count 1)) #:unwind? #t)))))) - (spawn-fiber - (lambda () - (while #t - (with-exception-handler - (lambda (exn) - (log-msg 'ERROR "nar removal pass failed " exn)) - run-removal-pass - #:unwind? #t) - (sleep (* 60 60 24))))) + (when storage-root + (spawn-fiber + (lambda () + (while #t + (with-exception-handler + (lambda (exn) + (log-msg 'ERROR "nar removal pass failed " exn)) + run-removal-pass + #:unwind? #t) + (sleep (* 60 60 24)))))) removal-channel) |