diff options
Diffstat (limited to 'guix-data-service/data-deletion.scm')
| -rw-r--r-- | guix-data-service/data-deletion.scm | 69 |
1 files changed, 50 insertions, 19 deletions
diff --git a/guix-data-service/data-deletion.scm b/guix-data-service/data-deletion.scm index c9dc631..13b3246 100644 --- a/guix-data-service/data-deletion.scm +++ b/guix-data-service/data-deletion.scm @@ -146,7 +146,7 @@ AND id NOT IN ( (delete-unreferenced-lint-checkers)))) (define (delete-revisions-from-branch conn git-repository-id branch-name commits) - (define (delete-jobs conn) + (define (delete-jobs conn commits) (for-each (lambda (table) (exec-query @@ -217,9 +217,7 @@ WHERE id IN ( 'delete-revisions-from-branch) (exec-query conn "SET LOCAL lock_timeout = '5s';") - (delete-from-git-commits conn) - (delete-jobs conn) (let ((git-branch-id (git-branch-for-repository-and-name conn @@ -232,7 +230,28 @@ WHERE id IN ( DROP TABLE IF EXISTS package_derivations_by_guix_revision_range_git_branch_" (number->string git-branch-id) ";"))) - (delete-guix-revisions conn git-repository-id commits)))) + (let ((now-unreferenced-commits + (filter + (lambda (commit) + (let ((result + (or + (string-null? commit) + (null? + (exec-query + conn + "SELECT 1 FROM git_commits WHERE commit = $1" + (list commit)))))) + (unless result + (simple-format (current-error-port) + "skipping ~A because it's still referenced\n" + commit)) + result)) + commits))) + (unless (null? now-unreferenced-commits) + (delete-jobs conn now-unreferenced-commits) + (delete-guix-revisions conn + git-repository-id + now-unreferenced-commits)))))) (lambda (key . args) (simple-format (current-error-port) @@ -255,10 +274,11 @@ WHERE git_repository_id = $1 (list (number->string git-repository-id) branch-name)))) - (delete-revisions-from-branch conn - git-repository-id - branch-name - commits) + (unless (null? commits) + (delete-revisions-from-branch conn + git-repository-id + branch-name + commits)) (exec-query conn @@ -434,10 +454,9 @@ DELETE FROM derivation_source_files WHERE id IN ( SELECT id FROM derivation_source_files - WHERE NOT EXISTS ( - SELECT 1 + WHERE id NOT IN ( + SELECT derivation_source_file_id FROM derivation_sources - WHERE derivation_source_file_id = derivation_source_files.id ) LIMIT 100 ) @@ -551,6 +570,7 @@ DELETE FROM derivations WHERE id = $1" 1))) (define deleted-count 0) + (define ignored-derivation-ids (make-hash-table)) (define channel (make-channel)) (define (delete-batch conn) @@ -588,7 +608,8 @@ WHERE NOT EXISTS ( (set! deleted-count 0) (for-each (lambda (derivation-id) - (put-message channel derivation-id)) + (unless (hash-ref ignored-derivation-ids derivation-id) + (put-message channel derivation-id))) derivations)) (simple-format (current-error-port) @@ -635,6 +656,11 @@ SET CONSTRAINTS derivations_by_output_details_set_derivation_id_fkey DEFERRED") 0)))) + (when (= 0 val) + (hash-set! ignored-derivation-ids + derivation-id + #t)) + ;; This is safe as all fibers are in the same ;; thread and cooperative. (set! deleted-count @@ -653,13 +679,18 @@ SET CONSTRAINTS derivations_by_output_details_set_derivation_id_fkey DEFERRED") (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)) + (hash-clear! ignored-derivation-ids) + (let ((batch-deleted-count (delete-batch conn))) + (if (= 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))))) (loop (+ total-deleted batch-deleted-count)))))))) #:hz 0 #:parallelism 1)) |