cbaines pushed a commit to branch trunk
in repository data-service.
commit b904fdb16108da1d604ba9c2c46811e41d4736b4
Author: Christopher Baines <m...@cbaines.net>
AuthorDate: Mon Mar 17 10:26:21 2025 +0000
Try to address the issue of missing derivation outputs
---
guix-data-service/jobs/load-new-guix-revision.scm | 98 +++++++++++++++--------
guix-data-service/model/derivation.scm | 22 +++--
2 files changed, 80 insertions(+), 40 deletions(-)
diff --git a/guix-data-service/jobs/load-new-guix-revision.scm
b/guix-data-service/jobs/load-new-guix-revision.scm
index 4ba7d5e..1d740a7 100644
--- a/guix-data-service/jobs/load-new-guix-revision.scm
+++ b/guix-data-service/jobs/load-new-guix-revision.scm
@@ -135,7 +135,24 @@
#:on-exception on-exception))
(raise-exception exn)))
thunk
- #:unwind? #t))
+ #:unwind? #t
+ #:unwind-for-type &missing-store-item-error))
+
+(define* (retry-on-missing-derivation-output thunk #:key on-exception)
+ (with-exception-handler
+ (lambda (exn)
+ (simple-format (current-error-port)
+ "missing derivation output ~A ~A, retrying ~A\n"
+ (missing-derivation-output-error-name exn)
+ (missing-derivation-output-error-path exn)
+ thunk)
+ (when on-exception (on-exception))
+ (retry-on-missing-store-item
+ thunk
+ #:on-exception on-exception))
+ thunk
+ #:unwind? #t
+ #:unwind-for-type &missing-derivation-output-error))
(define (inferior-guix-systems inf)
;; The order shouldn't matter here, but bugs in Guix can lead to different
@@ -1182,6 +1199,32 @@ SELECT 1 FROM derivation_source_file_nars WHERE
derivation_source_file_id = $1"
(values derivations
derivation-ids)))))))
+ (define (insert-input-derivations derivations)
+ (with-time-logging
+ (string-append
+ "insert-missing-derivations: ensure-input-derivations-exist ("
+ log-tag ")")
+ (let ((input-derivations
+ (vector-fold
+ (lambda (_ result drv)
+ (append! (map derivation-input-derivation
+ (derivation-inputs drv))
+ result))
+ '()
+ derivations)))
+ (unless (null? input-derivations)
+ ;; Ensure all the input derivations exist
+ (chunk-for-each!
+ (lambda (chunk)
+ (insert-missing-derivations
+ postgresql-connection-pool
+ call-with-utility-thread
+ derivation-ids-hash-table
+ chunk
+ #:log-tag log-tag))
+ 1000
+ input-derivations)))))
+
(let ((derivations
derivation-ids
(insert-derivations)))
@@ -1204,44 +1247,29 @@ SELECT 1 FROM derivation_source_file_nars WHERE
derivation_source_file_id = $1"
(derivation-outputs derivation)))
derivation-ids
derivations)))
-
- (with-time-logging
- (string-append
- "insert-missing-derivations: ensure-input-derivations-exist ("
- log-tag ")")
- (let ((input-derivations
- (vector-fold
- (lambda (_ result drv)
- (append! (map derivation-input-derivation
- (derivation-inputs drv))
- result))
- '()
- derivations)))
- (unless (null? input-derivations)
- ;; Ensure all the input derivations exist
- (chunk-for-each!
- (lambda (chunk)
- (insert-missing-derivations
- postgresql-connection-pool
- call-with-utility-thread
- derivation-ids-hash-table
- chunk
- #:log-tag log-tag))
- 1000
- input-derivations)))))
+ (insert-input-derivations derivations))
(simple-format
(current-error-port)
"debug: insert-missing-derivations: done parallel (~A)\n" log-tag)
- (with-resource-from-pool postgresql-connection-pool conn
- (with-time-logging
- (simple-format
- #f "insert-missing-derivations: inserting inputs for ~A
derivations (~A)"
- (vector-length derivations)
- log-tag)
- (insert-derivation-inputs conn
- derivation-ids
- derivations))))))
+ (retry-on-missing-derivation-output
+ (lambda ()
+ (with-resource-from-pool postgresql-connection-pool conn
+ (with-time-logging
+ (simple-format
+ #f "insert-missing-derivations: inserting inputs for ~A
derivations (~A)"
+ (vector-length derivations)
+ log-tag)
+ (insert-derivation-inputs conn
+ derivation-ids
+ derivations))))
+ #:on-exception
+ (lambda ()
+ ;; If this has happened because derivations have been removed, it
+ ;; might be necessary to insert them in the database where they
+ ;; previously existed
+ (hash-clear! derivation-ids-hash-table)
+ (insert-input-derivations derivations))))))
(define (fix-derivation file-name)
(define (derivation-missing-inputs? conn drv-id)
diff --git a/guix-data-service/model/derivation.scm
b/guix-data-service/model/derivation.scm
index 215b46f..6ee7de1 100644
--- a/guix-data-service/model/derivation.scm
+++ b/guix-data-service/model/derivation.scm
@@ -21,6 +21,7 @@
#:use-module (ice-9 vlist)
#:use-module (ice-9 match)
#:use-module (ice-9 format)
+ #:use-module (ice-9 exceptions)
#:use-module (ice-9 binary-ports)
#:use-module (rnrs bytevectors)
#:use-module (squee)
@@ -73,7 +74,12 @@
update-derivation-inputs-statistics
vacuum-derivation-inputs-table
update-derivation-outputs-statistics
- vacuum-derivation-outputs-table))
+ vacuum-derivation-outputs-table
+
+ &missing-derivation-output-error
+ missing-derivation-output-error?
+ missing-derivation-output-error-name
+ missing-derivation-output-error-path))
(define (valid-targets conn)
'("arm-linux-gnueabihf"
@@ -1128,12 +1134,19 @@ ON CONFLICT DO NOTHING"
(vector->list (json-string->scm env_vars)))
system))))
+(define-exception-type &missing-derivation-output-error &error
+ make-derivation-output-error
+ missing-derivation-output-error?
+ (name missing-derivation-output-error-name)
+ (path missing-derivation-output-error-path))
+
(define select-derivation-output-id
(mlambda (conn name path)
(match (exec-query
conn
"
-SELECT derivation_outputs.id FROM derivation_outputs
+SELECT derivation_outputs.id
+FROM derivation_outputs
INNER JOIN derivations
ON derivation_outputs.derivation_id = derivations.id
WHERE derivations.file_name = $1
@@ -1143,9 +1156,8 @@ WHERE derivations.file_name = $1
(((id))
id)
(()
- (error (simple-format
- #f "cannot find derivation-output with name ~A and path ~A"
- name path))))))
+ (raise-exception
+ (make-derivation-output-error name path))))))
(define (select-derivation-outputs-by-derivation-id conn id)
(define query
