mirror of
git://git.savannah.gnu.org/guix/data-service.git
synced 2023-12-14 03:23:03 +01:00
Add code to delete nars entries
This commit is contained in:
parent
1461aa037f
commit
9f102dbd39
1 changed files with 60 additions and 1 deletions
|
@ -32,7 +32,8 @@
|
||||||
delete-revisions-from-branch-except-most-recent-n
|
delete-revisions-from-branch-except-most-recent-n
|
||||||
delete-revisions-for-all-branches-except-most-recent-n
|
delete-revisions-for-all-branches-except-most-recent-n
|
||||||
delete-data-for-all-deleted-branches
|
delete-data-for-all-deleted-branches
|
||||||
delete-unreferenced-derivations))
|
delete-unreferenced-derivations
|
||||||
|
delete-nars-for-unknown-store-paths))
|
||||||
|
|
||||||
(define (delete-guix-revisions conn git-repository-id commits)
|
(define (delete-guix-revisions conn git-repository-id commits)
|
||||||
(define (delete-unreferenced-package-derivations)
|
(define (delete-unreferenced-package-derivations)
|
||||||
|
@ -662,3 +663,61 @@ SET CONSTRAINTS derivations_by_output_details_set_derivation_id_fkey DEFERRED")
|
||||||
(loop (+ total-deleted batch-deleted-count))))))))
|
(loop (+ total-deleted batch-deleted-count))))))))
|
||||||
#:hz 0
|
#:hz 0
|
||||||
#:parallelism 1))
|
#:parallelism 1))
|
||||||
|
|
||||||
|
(define (delete-nars-for-unknown-store-paths)
|
||||||
|
(define (get-nar-ids-batch conn)
|
||||||
|
(map
|
||||||
|
car
|
||||||
|
(exec-query
|
||||||
|
conn
|
||||||
|
"
|
||||||
|
SELECT id
|
||||||
|
FROM nars
|
||||||
|
WHERE NOT EXISTS
|
||||||
|
(
|
||||||
|
SELECT 1 FROM derivation_output_details
|
||||||
|
WHERE derivation_output_details.path = nars.store_path
|
||||||
|
)
|
||||||
|
LIMIT 50")))
|
||||||
|
|
||||||
|
(define (delete-narinfo-signature-data conn nar-ids)
|
||||||
|
(exec-query
|
||||||
|
conn
|
||||||
|
(string-append
|
||||||
|
"
|
||||||
|
DELETE FROM narinfo_signature_data
|
||||||
|
WHERE id IN (
|
||||||
|
SELECT narinfo_signature_data_id
|
||||||
|
FROM narinfo_signatures
|
||||||
|
WHERE nar_id IN ("
|
||||||
|
(string-join nar-ids ",")
|
||||||
|
")
|
||||||
|
)")))
|
||||||
|
|
||||||
|
(define (delete-nars conn nar-ids)
|
||||||
|
(exec-query
|
||||||
|
conn
|
||||||
|
(string-append
|
||||||
|
"
|
||||||
|
DELETE FROM nars WHERE id IN ("
|
||||||
|
(string-join nar-ids ",")
|
||||||
|
"
|
||||||
|
)")))
|
||||||
|
|
||||||
|
(with-postgresql-connection
|
||||||
|
"data-deletion"
|
||||||
|
(lambda (conn)
|
||||||
|
(with-advisory-session-lock
|
||||||
|
conn
|
||||||
|
'delete-nars-for-unknown-store-paths
|
||||||
|
(lambda ()
|
||||||
|
(newline)
|
||||||
|
(let loop ((nar-ids (get-nar-ids-batch conn)))
|
||||||
|
(unless (null? nar-ids)
|
||||||
|
(delete-narinfo-signature-data conn nar-ids)
|
||||||
|
(delete-nars conn nar-ids)
|
||||||
|
|
||||||
|
(display ".")
|
||||||
|
(force-output)
|
||||||
|
|
||||||
|
(loop (get-nar-ids-batch conn)))))))))
|
||||||
|
|
Loading…
Reference in a new issue