me/guix
Archived
1
0
Fork 0
Code Activity

copy: Factorize 'with-store' & co.

Browse source 
* 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'.
This commit is contained in:
Ludovic Courtès 2020-03-22 12:19:49 +01:00
parent 9b771305df
commit 7473238f7d
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 41 additions and 43 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

84
guix/scripts/copy.scm
View file

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -61,49 +61,45 @@ number (or #f) corresponding to SPEC."
(x (x
(leave (G_ "~a: invalid SSH specification~%") spec)))) (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 ; "Send ITEMS to TARGET. ITEMS is a list of store items or package names; for ;
package names, build the underlying packages before sending them." package names, build the underlying packages before sending them."
(with-store local (let-values (((user host port)
(set-build-options-from-command-line local opts) (ssh-spec->user+host+port target))
(let-values (((user host port) ((drv items)
(ssh-spec->user+host+port target)) (options->derivations+files local opts)))
((drv items) (show-what-to-build local drv
(options->derivations+files local opts))) #:use-substitutes? (assoc-ref opts 'substitutes?)
(show-what-to-build local drv #:dry-run? (assoc-ref opts 'dry-run?))
#:use-substitutes? (assoc-ref opts 'substitutes?)
#:dry-run? (assoc-ref opts 'dry-run?))
(and (or (assoc-ref opts 'dry-run?) (and (or (assoc-ref opts 'dry-run?)
(build-derivations local drv)) (build-derivations local drv))
(let* ((session (open-ssh-session host #:user user (let* ((session (open-ssh-session host #:user user
#:port (or port 22))) #:port (or port 22)))
(sent (send-files local items (sent (send-files local items
(connect-to-remote-daemon session) (connect-to-remote-daemon session)
#:recursive? #t))) #:recursive? #t)))
(format #t "~{~a~%~}" sent) (format #t "~{~a~%~}" sent)
sent))))) sent))))
(define (retrieve-from-remote-host source opts) (define (retrieve-from-remote-host local source opts)
"Retrieve ITEMS from SOURCE." "Retrieve ITEMS from SOURCE."
(with-store local (let*-values (((user host port)
(let*-values (((user host port) (ssh-spec->user+host+port source))
(ssh-spec->user+host+port source)) ((session)
((session) (open-ssh-session host #:user user #:port (or port 22)))
(open-ssh-session host #:user user #:port (or port 22))) ((remote)
((remote) (connect-to-remote-daemon session)))
(connect-to-remote-daemon session))) ;; TODO: Here we could to compute and build the derivations on REMOTE
(set-build-options-from-command-line local opts) ;; rather than on LOCAL (one-off offloading) but that is currently too
;; TODO: Here we could to compute and build the derivations on REMOTE ;; slow due to the many RPC round trips. So we just assume that REMOTE
;; rather than on LOCAL (one-off offloading) but that is currently too ;; contains ITEMS.
;; slow due to the many RPC round trips. So we just assume that REMOTE (let*-values (((drv items)
;; contains ITEMS. (options->derivations+files local opts))
(let*-values (((drv items) ((retrieved)
(options->derivations+files local opts)) (retrieve-files local items remote #:recursive? #t)))
((retrieved) (format #t "~{~a~%~}" retrieved)
(retrieve-files local items remote #:recursive? #t))) retrieved)))
(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))) (let* ((opts (parse-command-line args %options (list %default-options)))
(source (assoc-ref opts 'source)) (source (assoc-ref opts 'source))
(target (assoc-ref opts 'destination))) (target (assoc-ref opts 'destination)))
(with-status-verbosity (assoc-ref opts 'verbosity) (with-store store
(cond (target (send-to-remote-host target opts)) (set-build-options-from-command-line store opts)
(source (retrieve-from-remote-host source opts)) (with-status-verbosity (assoc-ref opts 'verbosity)
(else (leave (G_ "use '--to' or '--from'~%")))))))) (cond (target (send-to-remote-host store target opts))
(source (retrieve-from-remote-host store source opts))
(else (leave (G_ "use '--to' or '--from'~%")))))))))