Add find-broken-derivations-in-revision

This commit is contained in:
Christopher Baines 2025-06-26 15:25:52 +02:00
parent 0dd14c0a67
commit cdb3669a0a

View file

@ -98,7 +98,8 @@
most-recent-n-load-new-guix-revision-jobs
fix-derivation
fix-derivation-source-file-nar))
fix-derivation-source-file-nar
find-broken-derivations-in-revision))
(define inferior-package-id
(@@ (guix inferior) inferior-package-id))
@ -1383,6 +1384,51 @@ SELECT store_path FROM derivation_source_files WHERE id = $1"
#:parallelism 1
#:drain? #t))
(define (find-broken-derivations-in-revision commit)
(run-fibers
(lambda ()
(concatenate!
(fibers-batch-map
(match-lambda
((system target)
(with-postgresql-connection
"fix"
(lambda (conn)
(peek system target)
(map
car
(exec-query
conn
(string-append
(get-sql-to-select-package-and-related-derivations-for-revision
conn
(commit->revision-id conn commit)
#:system-id (system->system-id conn system)
#:target target)
"
SELECT derivations.file_name
FROM all_derivations
INNER JOIN derivations ON all_derivations.derivation_id = derivations.id
WHERE builder != 'builtin:download'
AND builder != 'builtin:git-download'
AND NOT EXISTS (
SELECT 1 FROM derivation_inputs WHERE derivation_id = derivations.id
)")))))))
6
(with-postgresql-connection
"fix"
(lambda (conn)
(append!
(map (lambda (system)
(list system ""))
(list-systems conn))
(map (lambda (target)
(list "x86_64-linux" target))
(valid-targets conn))))))))
#:hz 0
#:parallelism 1
#:drain? #t))
(define* (derivation-file-names->derivation-ids postgresql-connection-pool
call-with-utility-thread
read-derivations/serialised