diff options
| author | Christopher Baines <mail@cbaines.net> | 2024-06-29 11:49:45 +0100 |
|---|---|---|
| committer | Christopher Baines <mail@cbaines.net> | 2024-06-29 11:49:45 +0100 |
| commit | 335715bc723d66702901c6a67815551efeed720e (patch) | |
| tree | 94ef518ae8a10f83f4ef61989d006b70c0a9eb27 /guix-data-service/data-deletion.scm | |
| parent | b5fbde5ac832e34987a05b1445c1c465c19d5340 (diff) | |
| download | data-service-335715bc723d66702901c6a67815551efeed720e.tar data-service-335715bc723d66702901c6a67815551efeed720e.tar.gz | |
Properly handle deleting commits that occur on multiple branches
Diffstat (limited to 'guix-data-service/data-deletion.scm')
| -rw-r--r-- | guix-data-service/data-deletion.scm | 24 |
1 files changed, 20 insertions, 4 deletions
diff --git a/guix-data-service/data-deletion.scm b/guix-data-service/data-deletion.scm index 3b6dbd0..39cd9a3 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,25 @@ 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 + (null? + (exec-query + conn + "SELECT 1 FROM git_commits WHERE commit = $1" + commit)))) + (unless result + (simple-format (current-error-port) + "skipping ~A because it's still referenced\n" + commit)) + result)) + 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) |