diff options
Diffstat (limited to 'guix-data-service/data-deletion.scm')
| -rw-r--r-- | guix-data-service/data-deletion.scm | 88 |
1 files changed, 46 insertions, 42 deletions
diff --git a/guix-data-service/data-deletion.scm b/guix-data-service/data-deletion.scm index 35ce39f..241b899 100644 --- a/guix-data-service/data-deletion.scm +++ b/guix-data-service/data-deletion.scm @@ -538,7 +538,7 @@ DELETE FROM derivations WHERE id = $1" 1))) - (define (delete-batch conn) + (define (delete-batch conn connection-pool) (let* ((derivations (with-time-logging "fetching batch of derivations" (map car @@ -580,29 +580,29 @@ WHERE NOT EXISTS ( derivation-id))) (let ((val - (with-thread-postgresql-connection - (lambda (conn) - (catch 'psql-query-error - (lambda () - (with-postgresql-transaction - conn - (lambda (conn) - (exec-query - conn - " + (call-with-resource-from-pool connection-pool + (lambda (conn) + (catch 'psql-query-error + (lambda () + (with-postgresql-transaction + conn + (lambda (conn) + (exec-query + conn + " SET CONSTRAINTS derivations_by_output_details_set_derivation_id_fkey DEFERRED") - (exec-query conn "SET LOCAL lock_timeout = '5s';") + (exec-query conn "SET LOCAL lock_timeout = '5s';") - (maybe-delete-derivation conn - derivation-id)))) - (lambda (key . args) - (simple-format - (current-error-port) - "error when attempting to delete derivation: ~A ~A\n" - key args) + (maybe-delete-derivation conn + derivation-id)))) + (lambda (key . args) + (simple-format + (current-error-port) + "error when attempting to delete derivation: ~A ~A\n" + key args) - 0)))))) + 0)))))) (monitor (set! deleted-count (+ val deleted-count))))) @@ -613,26 +613,30 @@ SET CONSTRAINTS derivations_by_output_details_set_derivation_id_fkey DEFERRED") deleted-count) deleted-count))) - (with-postgresql-connection-per-thread - "data-deletion-thread" + (run-fibers (lambda () - (run-fibers - (lambda () - (with-thread-postgresql-connection - (lambda (conn) - (obtain-advisory-transaction-lock - conn - 'delete-unreferenced-derivations) - - (let loop ((total-deleted 0)) - (let ((batch-deleted-count (delete-batch conn))) - (if (eq? 0 batch-deleted-count) - (begin - (with-time-logging - "Deleting unused derivation_source_files entries" - (delete-unreferenced-derivations-source-files conn)) - (simple-format - (current-output-port) - "Finished deleting derivations, deleted ~A in total\n" - total-deleted)) - (loop (+ total-deleted batch-deleted-count)))))))))))) + (let* ((connection-pool + (make-resource-pool + (lambda () + (open-postgresql-connection "data-deletion" #f)) + 8))) + + (with-postgresql-connection + "data-deletion" + (lambda (conn) + (obtain-advisory-transaction-lock + conn + 'delete-unreferenced-derivations) + + (let loop ((total-deleted 0)) + (let ((batch-deleted-count (delete-batch conn connection-pool))) + (if (eq? 0 batch-deleted-count) + (begin + (with-time-logging + "Deleting unused derivation_source_files entries" + (delete-unreferenced-derivations-source-files conn)) + (simple-format + (current-output-port) + "Finished deleting derivations, deleted ~A in total\n" + total-deleted)) + (loop (+ total-deleted batch-deleted-count))))))))))) |