[no subject]

[Ludovic Courtès]

branch: main
commit b69d5dd9b96bef99cdbdbc43d660d1b9415678a9
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Fri Jul 5 15:50:26 2024 +0200

    store: Add ‘ensure-store-items’.
    
    * src/cuirass/store.scm (ensure-store-items): New procedure.
---
 src/cuirass/store.scm | 31 +++++++++++++++++++++++++++++++
 1 file changed, 31 insertions(+)

diff --git a/src/cuirass/store.scm b/src/cuirass/store.scm
index 86e0f49..c2a73d3 100644
--- a/src/cuirass/store.scm
+++ b/src/cuirass/store.scm
@@ -22,6 +22,8 @@
   #:autoload   (guix derivations) (build-derivations
                                    derivation-path->output-paths)
   #:use-module ((guix config) #:select (%state-directory))
+  #:autoload   (cuirass logging) (log-info log-warning log-error)
+  #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-34)
   #:use-module (ice-9 match)
   #:autoload   (ice-9 rdelim) (read-line)
@@ -30,6 +32,7 @@
   #:export (non-blocking-port
             with-store/non-blocking
             process-build-log
+            ensure-store-items
             build-derivations&
 
             register-gc-root
@@ -150,6 +153,34 @@ does.  Return the result of the last call to PROC."
       ((? string? line)
        (loop (process-line line state))))))
 
+(define* (ensure-store-items store lst
+                             #:key (max-retries 10))
+  "Try really hard to ensure all the store items in LST are available locally,
+substituting them as necessary.  Retry up to MAX-RETRIES times upon
+'ensure-path' failures.  Return false on failure."
+  (define (available-item? item)
+    (guard (c ((store-protocol-error? c)
+               (log-warning "failed to substitute ~a: ~a"
+                            item (store-protocol-error-message c))
+               #f))
+      (ensure-path store item)))
+
+  (let loop ((lst lst)
+             (iterations 0))
+    (if (< iterations max-retries)
+        (let ((lst (remove available-item? lst)))
+          (or (null? lst)
+              (let ((delay (+ 60 (* iterations 30))))
+                (log-info "retrying substitution of ~a items in ~as"
+                          (length lst) delay)
+                (sleep delay)
+                (loop lst (+ 1 iterations)))))
+        (begin
+          (log-error "failed to substitute the following items after \
+~a retries:~{ ~a~}"
+                     max-retries lst)
+          #f))))
+
 (define (build-derivations& store lst)
   "Like 'build-derivations' but return two values: a file port from which to
 read the build log, and a thunk to call after EOF has been read.  The thunk