summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2020-03-22 12:19:49 +0100
committerLudovic Courtès <ludo@gnu.org>2020-03-22 12:42:52 +0100
commit7473238f7de28f9c85e364364c3155a3bbb877ac (patch)
tree8e8ea1a5be03526278b3f7951f67515166274d98
parent9b771305df5dfc31c06b81fbdeaae753ba5d4afe (diff)
downloadpatches-7473238f7de28f9c85e364364c3155a3bbb877ac.tar
patches-7473238f7de28f9c85e364364c3155a3bbb877ac.tar.gz
copy: Factorize 'with-store' & co.
* guix/scripts/copy.scm (send-to-remote-host): Remove 'with-store' and 'set-build-options-from-command-line' call. Add 'local' parameter. (retrieve-from-remote-host): Likewise. (guix-copy): Wrap 'with-status-verbosity' in 'with-store' and add call to 'set-build-options-from-command-line'.
-rw-r--r--guix/scripts/copy.scm84
1 files changed, 41 insertions, 43 deletions
diff --git a/guix/scripts/copy.scm b/guix/scripts/copy.scm
index 664cb32b7c..2542df6b19 100644
--- a/guix/scripts/copy.scm
+++ b/guix/scripts/copy.scm
@@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016, 2017, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -61,49 +61,45 @@ number (or #f) corresponding to SPEC."
(x
(leave (G_ "~a: invalid SSH specification~%") spec))))
-(define (send-to-remote-host target opts)
+(define (send-to-remote-host local target opts)
"Send ITEMS to TARGET. ITEMS is a list of store items or package names; for ;
package names, build the underlying packages before sending them."
- (with-store local
- (set-build-options-from-command-line local opts)
- (let-values (((user host port)
- (ssh-spec->user+host+port target))
- ((drv items)
- (options->derivations+files local opts)))
- (show-what-to-build local drv
- #:use-substitutes? (assoc-ref opts 'substitutes?)
- #:dry-run? (assoc-ref opts 'dry-run?))
+ (let-values (((user host port)
+ (ssh-spec->user+host+port target))
+ ((drv items)
+ (options->derivations+files local opts)))
+ (show-what-to-build local drv
+ #:use-substitutes? (assoc-ref opts 'substitutes?)
+ #:dry-run? (assoc-ref opts 'dry-run?))
- (and (or (assoc-ref opts 'dry-run?)
- (build-derivations local drv))
- (let* ((session (open-ssh-session host #:user user
- #:port (or port 22)))
- (sent (send-files local items
- (connect-to-remote-daemon session)
- #:recursive? #t)))
- (format #t "~{~a~%~}" sent)
- sent)))))
+ (and (or (assoc-ref opts 'dry-run?)
+ (build-derivations local drv))
+ (let* ((session (open-ssh-session host #:user user
+ #:port (or port 22)))
+ (sent (send-files local items
+ (connect-to-remote-daemon session)
+ #:recursive? #t)))
+ (format #t "~{~a~%~}" sent)
+ sent))))
-(define (retrieve-from-remote-host source opts)
+(define (retrieve-from-remote-host local source opts)
"Retrieve ITEMS from SOURCE."
- (with-store local
- (let*-values (((user host port)
- (ssh-spec->user+host+port source))
- ((session)
- (open-ssh-session host #:user user #:port (or port 22)))
- ((remote)
- (connect-to-remote-daemon session)))
- (set-build-options-from-command-line local opts)
- ;; TODO: Here we could to compute and build the derivations on REMOTE
- ;; rather than on LOCAL (one-off offloading) but that is currently too
- ;; slow due to the many RPC round trips. So we just assume that REMOTE
- ;; contains ITEMS.
- (let*-values (((drv items)
- (options->derivations+files local opts))
- ((retrieved)
- (retrieve-files local items remote #:recursive? #t)))
- (format #t "~{~a~%~}" retrieved)
- retrieved))))
+ (let*-values (((user host port)
+ (ssh-spec->user+host+port source))
+ ((session)
+ (open-ssh-session host #:user user #:port (or port 22)))
+ ((remote)
+ (connect-to-remote-daemon session)))
+ ;; TODO: Here we could to compute and build the derivations on REMOTE
+ ;; rather than on LOCAL (one-off offloading) but that is currently too
+ ;; slow due to the many RPC round trips. So we just assume that REMOTE
+ ;; contains ITEMS.
+ (let*-values (((drv items)
+ (options->derivations+files local opts))
+ ((retrieved)
+ (retrieve-files local items remote #:recursive? #t)))
+ (format #t "~{~a~%~}" retrieved)
+ retrieved)))
;;;
@@ -176,7 +172,9 @@ Copy ITEMS to or from the specified host over SSH.\n"))
(let* ((opts (parse-command-line args %options (list %default-options)))
(source (assoc-ref opts 'source))
(target (assoc-ref opts 'destination)))
- (with-status-verbosity (assoc-ref opts 'verbosity)
- (cond (target (send-to-remote-host target opts))
- (source (retrieve-from-remote-host source opts))
- (else (leave (G_ "use '--to' or '--from'~%"))))))))
+ (with-store store
+ (set-build-options-from-command-line store opts)
+ (with-status-verbosity (assoc-ref opts 'verbosity)
+ (cond (target (send-to-remote-host store target opts))
+ (source (retrieve-from-remote-host store source opts))
+ (else (leave (G_ "use '--to' or '--from'~%")))))))))