Add fix-derivation
To the load data module, since this is where most of the useful code is.
This commit is contained in:
parent
35281c8a49
commit
bf3fdfd8d3
1 changed files with 70 additions and 1 deletions
|
|
@ -95,7 +95,9 @@
|
||||||
guix-revision-loaded-successfully?
|
guix-revision-loaded-successfully?
|
||||||
record-job-event
|
record-job-event
|
||||||
enqueue-load-new-guix-revision-job
|
enqueue-load-new-guix-revision-job
|
||||||
most-recent-n-load-new-guix-revision-jobs))
|
most-recent-n-load-new-guix-revision-jobs
|
||||||
|
|
||||||
|
fix-derivation))
|
||||||
|
|
||||||
(define inferior-package-id
|
(define inferior-package-id
|
||||||
(@@ (guix inferior) inferior-package-id))
|
(@@ (guix inferior) inferior-package-id))
|
||||||
|
|
@ -1229,6 +1231,73 @@ SELECT 1 FROM derivation_source_file_nars WHERE derivation_source_file_id = $1"
|
||||||
derivation-ids
|
derivation-ids
|
||||||
derivations))))))
|
derivations))))))
|
||||||
|
|
||||||
|
(define (fix-derivation file-name)
|
||||||
|
(define (derivation-missing-inputs? conn drv-id)
|
||||||
|
(let ((inputs (select-derivation-inputs-by-derivation-id
|
||||||
|
conn
|
||||||
|
drv-id)))
|
||||||
|
;; TODO Detect missing inputs, as well as them all missing
|
||||||
|
(null? inputs)))
|
||||||
|
|
||||||
|
(define (derivation-missing-sources? conn drv-id)
|
||||||
|
(let ((sources (select-derivation-sources-by-derivation-id
|
||||||
|
conn
|
||||||
|
drv-id)))
|
||||||
|
;; TODO Detect missing inputs, as well as them all missing
|
||||||
|
(null? sources)))
|
||||||
|
|
||||||
|
(run-fibers
|
||||||
|
(lambda ()
|
||||||
|
(with-postgresql-connection
|
||||||
|
"fix"
|
||||||
|
(lambda (conn)
|
||||||
|
(let ((drv (read-derivation-from-file file-name))
|
||||||
|
(postgresql-connection-pool
|
||||||
|
(make-resource-pool
|
||||||
|
(const conn)
|
||||||
|
1
|
||||||
|
#:name "postgres"))
|
||||||
|
(call-with-utility-thread
|
||||||
|
(lambda (thunk)
|
||||||
|
(thunk)))
|
||||||
|
(derivation-ids-hash-table
|
||||||
|
(make-hash-table)))
|
||||||
|
|
||||||
|
(match (select-derivation-by-file-name conn (derivation-file-name drv))
|
||||||
|
((drv-id rest ...)
|
||||||
|
(when (and (derivation-missing-sources? conn drv-id)
|
||||||
|
(not (null? (derivation-sources drv))))
|
||||||
|
(with-postgresql-transaction
|
||||||
|
conn
|
||||||
|
(lambda (conn)
|
||||||
|
(derivations-insert-sources postgresql-connection-pool
|
||||||
|
call-with-utility-thread
|
||||||
|
(vector drv)
|
||||||
|
(vector drv-id)))))
|
||||||
|
|
||||||
|
(when (and (derivation-missing-inputs? conn drv-id)
|
||||||
|
(not (null? (derivation-inputs drv))))
|
||||||
|
(with-postgresql-transaction
|
||||||
|
conn
|
||||||
|
(lambda (conn)
|
||||||
|
(let ((input-derivations
|
||||||
|
(map derivation-input-derivation
|
||||||
|
(derivation-inputs drv))))
|
||||||
|
(unless (null? input-derivations)
|
||||||
|
;; Ensure all the input derivations exist
|
||||||
|
(for-each
|
||||||
|
(lambda (chunk)
|
||||||
|
(insert-missing-derivations
|
||||||
|
postgresql-connection-pool
|
||||||
|
call-with-utility-thread
|
||||||
|
derivation-ids-hash-table
|
||||||
|
chunk))
|
||||||
|
(chunk! input-derivations 1000))))))
|
||||||
|
|
||||||
|
(fix-derivation-inputs conn drv))))))))
|
||||||
|
#:hz 0
|
||||||
|
#:parallelism 1))
|
||||||
|
|
||||||
(define* (derivation-file-names->derivation-ids postgresql-connection-pool
|
(define* (derivation-file-names->derivation-ids postgresql-connection-pool
|
||||||
call-with-utility-thread
|
call-with-utility-thread
|
||||||
read-derivations/fiberized
|
read-derivations/fiberized
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue