Fix delete-unreferenced-derivations

This commit is contained in:
Christopher Baines 2020-10-04 13:23:00 +01:00
parent 93c9813546
commit 48673b32cb

View file

@ -21,6 +21,7 @@
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 threads) #:use-module (ice-9 threads)
#:use-module (squee) #:use-module (squee)
#:use-module (fibers)
#:use-module (guix-data-service utils) #:use-module (guix-data-service utils)
#:use-module (guix-data-service database) #:use-module (guix-data-service database)
#:use-module (guix-data-service model package-derivation-by-guix-revision-range) #:use-module (guix-data-service model package-derivation-by-guix-revision-range)
@ -411,10 +412,6 @@ DELETE FROM derivations WHERE id = $1"
1))) 1)))
(define conn-channel
(make-postgresql-connection-channel
"data-deletion-thread"))
(with-postgresql-connection (with-postgresql-connection
"data-deletion" "data-deletion"
(lambda (conn) (lambda (conn)
@ -452,26 +449,35 @@ WHERE NOT EXISTS (
(lambda (count result) (lambda (count result)
(+ result count)) (+ result count))
0 0
(par-map& (lambda (derivation-id) (par-map&
(lambda (derivation-id)
(with-thread-postgresql-connection (with-thread-postgresql-connection
(lambda (conn)
(with-postgresql-transaction
conn
(lambda (conn) (lambda (conn)
(exec-query (exec-query
conn conn
" "
SET CONSTRAINTS derivations_by_output_details_set_derivation_id_fkey DEFERRED") SET CONSTRAINTS derivations_by_output_details_set_derivation_id_fkey DEFERRED")
(maybe-delete-derivation conn derivation-id)))) (maybe-delete-derivation conn
derivation-id))))))
derivations)))) derivations))))
(simple-format (current-error-port) (simple-format (current-error-port)
"Deleted ~A derivations\n" "Deleted ~A derivations\n"
deleted-count) deleted-count)
deleted-count))) deleted-count)))
(with-postgresql-connection-per-thread
"data-deletion-thread"
(lambda ()
(run-fibers
(lambda ()
(let loop ((total-deleted 0)) (let loop ((total-deleted 0))
(let ((batch-deleted-count (delete-batch conn))) (let ((batch-deleted-count (delete-batch conn)))
(if (eq? 0 batch-deleted-count) (if (eq? 0 batch-deleted-count)
(begin (begin
(close-postgresql-connection-channel conn-channel)
(simple-format (simple-format
(current-output-port) (current-output-port)
"Deleting unused derivation_source_files entries") "Deleting unused derivation_source_files entries")
@ -480,4 +486,4 @@ SET CONSTRAINTS derivations_by_output_details_set_derivation_id_fkey DEFERRED")
(current-output-port) (current-output-port)
"Finished deleting derivations, deleted ~A in total\n" "Finished deleting derivations, deleted ~A in total\n"
total-deleted)) total-deleted))
(loop (+ total-deleted batch-deleted-count)))))))) (loop (+ total-deleted batch-deleted-count))))))))))))