diff options
author | Efraim Flashner <efraim@flashner.co.il> | 2020-09-05 21:56:34 +0300 |
---|---|---|
committer | Efraim Flashner <efraim@flashner.co.il> | 2020-09-05 22:30:04 +0300 |
commit | de3c03a47160dec355d9b19ad5ca210d90c15fd7 (patch) | |
tree | 4ca6dc05b5fc9530d812bbb269f1c61ab9efccf3 /guix/store.scm | |
parent | ab6fe9d362046231ad6f46eccfd1ea2c9c80b401 (diff) | |
parent | b8477cab7bccc4191ed3dfa3f149aec7917834d8 (diff) | |
download | guix-patches-de3c03a47160dec355d9b19ad5ca210d90c15fd7.tar guix-patches-de3c03a47160dec355d9b19ad5ca210d90c15fd7.tar.gz |
Merge remote-tracking branch 'origin/master' into staging
Diffstat (limited to 'guix/store.scm')
-rw-r--r-- | guix/store.scm | 33 |
1 files changed, 25 insertions, 8 deletions
diff --git a/guix/store.scm b/guix/store.scm index 683e125b20..d859ea33ed 100644 --- a/guix/store.scm +++ b/guix/store.scm @@ -628,9 +628,10 @@ connection. Use with care." (define (thunk) (parameterize ((current-store-protocol-version (store-connection-version store))) - (let ((result (proc store))) - (close-connection store) - result))) + (call-with-values (lambda () (proc store)) + (lambda results + (close-connection store) + (apply values results))))) (cond-expand (guile-3 @@ -819,7 +820,7 @@ encoding conversion errors." (terminal-columns (terminal-columns)) ;; Locale of the client. - (locale (false-if-exception (setlocale LC_ALL)))) + (locale (false-if-exception (setlocale LC_MESSAGES)))) ;; Must be called after `open-connection'. (define buffered @@ -1727,10 +1728,20 @@ is raised if the set of paths read from PORT is not signed (as per (or done? (loop (process-stderr server port)))) (= 1 (read-int s)))) -(define* (export-paths server paths port #:key (sign? #t) recursive?) +(define* (export-paths server paths port #:key (sign? #t) recursive? + (start (const #f)) + (progress (const #f)) + (finish (const #f))) "Export the store paths listed in PATHS to PORT, in topological order, signing them if SIGN? is true. When RECURSIVE? is true, export the closure of -PATHS---i.e., PATHS and all their dependencies." +PATHS---i.e., PATHS and all their dependencies. + +START, PROGRESS, and FINISH are used to track progress of the data transfer. +START is a one-argument that is passed the list of store items that will be +transferred; it returns values that are then used as the initial state +threaded through PROGRESS calls. PROGRESS is passed the store item about to +be sent, along with the values previously return by START or by PROGRESS +itself. FINISH is called when the last store item has been called." (define ordered (let ((sorted (topologically-sorted server paths))) ;; When RECURSIVE? is #f, filter out the references of PATHS. @@ -1738,14 +1749,20 @@ PATHS---i.e., PATHS and all their dependencies." sorted (filter (cut member <> paths) sorted)))) - (let loop ((paths ordered)) + (let loop ((paths ordered) + (state (call-with-values (lambda () (start ordered)) + list))) (match paths (() + (apply finish state) (write-int 0 port)) ((head tail ...) (write-int 1 port) (and (export-path server head port #:sign? sign?) - (loop tail)))))) + (loop tail + (call-with-values + (lambda () (apply progress head state)) + list))))))) (define-operation (query-failed-paths) "Return the list of store items for which a build failure is cached. |