diff options
Diffstat (limited to 'guix')
-rw-r--r-- | guix/remote.scm | 11 | ||||
-rw-r--r-- | guix/store.scm | 18 |
2 files changed, 13 insertions, 16 deletions
diff --git a/guix/remote.scm b/guix/remote.scm index 37e9827084..f6adb22846 100644 --- a/guix/remote.scm +++ b/guix/remote.scm @@ -146,15 +146,6 @@ remote store." sources))) (mbegin %store-monad ((store-lift send-files) to-send remote #:recursive? #t) - - ;; Build handlers are not tied to a specific <store-connection>. - ;; If a handler is already installed, it might want to go ahead - ;; and build, but on the local <store-connection> instead of - ;; REMOTE. To avoid that, install a build handler that does - ;; nothing. - (return (with-build-handler (lambda (continue . _) - (continue #t)) - (build-derivations remote inputs))) - + (return (build-derivations remote inputs)) (return (close-connection remote)) (return (%remote-eval lowered session become-command))))))) diff --git a/guix/store.scm b/guix/store.scm index 89a719bcfc..7388953d15 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -1349,11 +1349,14 @@ on the build output of a previous derivation." (things unresolved-things) (continuation unresolved-continuation)) -(define (build-accumulator continue store things mode) - "This build handler accumulates THINGS and returns an <unresolved> object." - (if (= mode (build-mode normal)) - (unresolved things continue) - (continue #t))) +(define (build-accumulator expected-store) + "Return a build handler that accumulates THINGS and returns an <unresolved> +object, only for build requests on EXPECTED-STORE." + (lambda (continue store things mode) + (if (and (eq? store expected-store) + (= mode (build-mode normal))) + (unresolved things continue) + (continue #t)))) (define* (map/accumulate-builds store proc lst #:key (cutoff 30)) @@ -1366,13 +1369,16 @@ CUTOFF is the threshold above which we stop accumulating unresolved nodes." ;; stumbling upon the same .drv build requests with many incoming edges. ;; See <https://bugs.gnu.org/49439>. + (define accumulator + (build-accumulator store)) + (define-values (result rest) (let loop ((lst lst) (result '()) (unresolved 0)) (match lst ((head . tail) - (match (with-build-handler build-accumulator + (match (with-build-handler accumulator (proc head)) ((? unresolved? obj) (if (>= unresolved cutoff) |