cbaines pushed a commit to branch master
in repository data-service.
commit 371d76456f90f2bcc243af1a4dbf15f874024ef9
Author: Christopher Baines <[email protected]>
AuthorDate: Thu Aug 8 13:31:14 2024 +0100
Start trying to handle GC happening while processing revisions
---
guix-data-service/jobs/load-new-guix-revision.scm | 85 ++++++++++++++++++-----
tests/jobs-load-new-guix-revision.scm | 3 +-
2 files changed, 71 insertions(+), 17 deletions(-)
diff --git a/guix-data-service/jobs/load-new-guix-revision.scm
b/guix-data-service/jobs/load-new-guix-revision.scm
index a8e056d..2d6af34 100644
--- a/guix-data-service/jobs/load-new-guix-revision.scm
+++ b/guix-data-service/jobs/load-new-guix-revision.scm
@@ -22,6 +22,7 @@
#:use-module (srfi srfi-71)
#:use-module (ice-9 match)
#:use-module (ice-9 threads)
+ #:use-module (ice-9 exceptions)
#:use-module (ice-9 textual-ports)
#:use-module (ice-9 hash-table)
#:use-module (ice-9 suspendable-ports)
@@ -101,6 +102,25 @@
(simple-format #t "debug: Finished ~A, took ~A seconds\n"
action time-taken)))))
+(define-exception-type &missing-store-item-error &error
+ make-missing-store-item-error
+ missing-store-item-error?
+ (item missing-store-item-error-item))
+
+(define (retry-on-missing-store-item thunk)
+ (with-exception-handler
+ (lambda (exn)
+ (if (missing-store-item-error? exn)
+ (begin
+ (simple-format (current-error-port)
+ "missing store item ~A, retrying ~A\n"
+ (missing-store-item-error-item exn)
+ thunk)
+ (retry-on-missing-store-item thunk))
+ (raise-exception exn)))
+ thunk
+ #:unwind? #t))
+
(define (inferior-guix-systems inf)
;; The order shouldn't matter here, but bugs in Guix can lead to different
;; results depending on the order, so sort the systems to try and provide
@@ -1063,6 +1083,10 @@ SELECT 1 FROM derivation_source_file_nars WHERE
derivation_source_file_id = $1"
(lambda ()
(open-bytevector-output-port))
(lambda (port get-bytevector)
+ (unless (file-exists? source-file)
+ (raise-exception
+ (make-missing-store-item-error
+ source-file)))
(write-file source-file port)
(get-bytevector)))))))
(letpar&
@@ -1164,7 +1188,13 @@ SELECT 1 FROM derivation_source_file_nars WHERE
derivation_source_file_id = $1"
(lambda (chunk)
(fibers-delay
(lambda ()
- (map read-derivation-from-file chunk))))
+ (map (lambda (filename)
+ (if (file-exists? filename)
+ (read-derivation-from-file filename)
+ (raise-exception
+ (make-missing-store-item-error
+ filename))))
+ chunk))))
(chunk! missing-derivation-filenames 1000))))
(for-each
@@ -1547,8 +1577,10 @@ SELECT 1 FROM derivation_source_file_nars WHERE
derivation_source_file_id = $1"
(lambda (store)
(build-derivations store (list
derivation-for-current-system)))))
- (store-item->guix-store-item
- (derivation->output-path derivation-for-current-system)))
+ (values
+ (store-item->guix-store-item
+ (derivation->output-path derivation-for-current-system))
+ derivation-file-name-for-current-system))
#f)))
(prevent-inlining-for-tests channel-derivations-by-system->guix-store-item)
@@ -1693,6 +1725,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE
derivation_source_file_id = $1"
(define* (extract-information-from db-conn guix-revision-id commit
guix-source store-item
+ guix-derivation
utility-thread-channel
#:key skip-system-tests?
extra-inferior-environment-variables
@@ -1713,17 +1746,33 @@ SELECT 1 FROM derivation_source_file_nars WHERE
derivation_source_file_id = $1"
(define inf-and-store-pool
(make-resource-pool
(lambda ()
- (let* ((inferior-store (open-store-connection))
- (inferior (start-inferior-for-data-extration
- inferior-store
- store-item
- guix-locpath
- extra-inferior-environment-variables)))
- (ensure-non-blocking-store-connection inferior-store)
- (make-inferior-non-blocking! inferior)
- (simple-format #t "debug: started new inferior and store
connection\n")
-
- (cons inferior inferior-store)))
+ (let* ((inferior-store (open-store-connection)))
+ (unless (valid-path? inferior-store store-item)
+ (simple-format #t "warning: store item missing (~A)\n"
+ store-item)
+ (unless (valid-path? inferior-store guix-derivation)
+ (simple-format #t "warning: attempting to substitute guix
derivation (~A)\n"
+ guix-derivation)
+ (ensure-path inferior-store guix-derivation))
+ (simple-format #t "warning: building (~A)\n"
+ guix-derivation)
+ (build-derivations inferior-store
+ (list (read-derivation-from-file
+ guix-derivation))))
+ ;; Use this more to keep the store-path alive so long as there's a
+ ;; inferior operating
+ (add-temp-root inferior-store store-item)
+
+ (let ((inferior (start-inferior-for-data-extration
+ inferior-store
+ store-item
+ guix-locpath
+ extra-inferior-environment-variables)))
+ (ensure-non-blocking-store-connection inferior-store)
+ (make-inferior-non-blocking! inferior)
+ (simple-format #t "debug: started new inferior and store
connection\n")
+
+ (cons inferior inferior-store))))
parallelism
#:min-size 0
#:idle-seconds 2
@@ -1933,7 +1982,9 @@ SELECT 1 FROM derivation_source_file_nars WHERE
derivation_source_file_id = $1"
(par-map&
(match-lambda
((system . target)
- (process-system-and-target/fiberized system target)))
+ (retry-on-missing-store-item
+ (lambda ()
+ (process-system-and-target/fiberized system target)))))
(with-resource-from-pool inf-and-store-pool res
(match res
((inferior . inferior-store)
@@ -1980,7 +2031,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE
derivation_source_file_id = $1"
(parallel-via-fibers
(fibers-force package-ids-promise)
(extract-and-store-package-derivations)
- (extract-and-store-system-tests)
+ (retry-on-missing-store-item extract-and-store-system-tests)
(extract-and-store-lint-checkers-and-warnings)))
#t)
@@ -2082,6 +2133,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE
derivation_source_file_id = $1"
git-repository-id commit
channel-derivations-by-system)))
(let ((store-item
+ guix-derivation
(channel-derivations-by-system->guix-store-item
channel-derivations-by-system)))
(if store-item
@@ -2089,6 +2141,7 @@ SELECT 1 FROM derivation_source_file_nars WHERE
derivation_source_file_id = $1"
(extract-information-from conn
guix-revision-id
commit guix-source store-item
+ guix-derivation
utility-thread-channel
#:skip-system-tests?
skip-system-tests?
diff --git a/tests/jobs-load-new-guix-revision.scm
b/tests/jobs-load-new-guix-revision.scm
index 6d47fb9..78d9268 100644
--- a/tests/jobs-load-new-guix-revision.scm
+++ b/tests/jobs-load-new-guix-revision.scm
@@ -58,7 +58,8 @@
((guix-data-service jobs load-new-guix-revision)
channel-derivations-by-system->guix-store-item
(lambda (channel-derivations-by-system)
- "/gnu/store/test"))
+ (values "/gnu/store/test"
+ "/gnu/store/test.drv")))
(mock
((guix-data-service jobs load-new-guix-revision)
