nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

ssh: Allow transfers of complete closures. 

* guix/ssh.scm (store-export-channel, send-files)
(file-retrieval-port, retrieve-files): Add #:recursive? parameter and
honor it.
This commit is contained in:
Ludovic Courtès 2016-12-31 18:13:29 +01:00
parent c0b2d08bf4
commit e9629e8221
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 20 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

32
guix/ssh.scm
View File

@ -112,9 +112,10 @@ can be written."
,(object->string ,(object->string
(object->string import)))))) (object->string import))))))
(define (store-export-channel session files) (define* (store-export-channel session files
#:key recursive?)
"Return an input port from which an export of FILES from SESSION's store can "Return an input port from which an export of FILES from SESSION's store can
be read." be read. When RECURSIVE? is true, the closure of FILES is exported."
;; Same as above: this is more efficient than calling 'export-paths' on a ;; Same as above: this is more efficient than calling 'export-paths' on a
;; remote store. ;; remote store.
(define export (define export
@ -126,7 +127,8 @@ be read."
;; FIXME: Exceptions are silently swallowed. We should report them ;; FIXME: Exceptions are silently swallowed. We should report them
;; somehow. ;; somehow.
(export-paths store ',files (current-output-port))))) (export-paths store ',files (current-output-port)
#:recursive? ,recursive?))))
(open-remote-input-pipe session (open-remote-input-pipe session
(string-join (string-join
@ -135,11 +137,14 @@ be read."
(object->string export)))))) (object->string export))))))
(define* (send-files local files remote (define* (send-files local files remote
#:key (log-port (current-error-port))) #:key
recursive?
(log-port (current-error-port)))
"Send the subset of FILES from LOCAL (a local store) that's missing to "Send the subset of FILES from LOCAL (a local store) that's missing to
REMOTE, a remote store." REMOTE, a remote store. When RECURSIVE? is true, send the closure of FILES."
;; Compute the subset of FILES missing on SESSION and send them. ;; Compute the subset of FILES missing on SESSION and send them.
(let* ((session (channel-get-session (nix-server-socket remote))) (let* ((files (if recursive? (requisites local files) files))
(session (channel-get-session (nix-server-socket remote)))
(node (make-node session)) (node (make-node session))
(missing (node-eval node (missing (node-eval node
`(begin `(begin
@ -180,19 +185,22 @@ remote store as returned by 'connect-to-remote-daemon'."
((? session? session) ((? session? session)
(session-get session 'host)))) (session-get session 'host))))
(define (file-retrieval-port files remote) (define* (file-retrieval-port files remote
#:key recursive?)
"Return an input port from which to retrieve FILES (a list of store items) "Return an input port from which to retrieve FILES (a list of store items)
from REMOTE, along with the number of items to retrieve (lower than or equal from REMOTE, along with the number of items to retrieve (lower than or equal
to the length of FILES.)" to the length of FILES.)"
(values (store-export-channel (remote-store-session remote) files) (values (store-export-channel (remote-store-session remote) files
(length files))) #:recursive? recursive?)
(length files))) ;XXX: inaccurate when RECURSIVE? is true
(define* (retrieve-files local files remote (define* (retrieve-files local files remote
#:key (log-port (current-error-port))) #:key recursive? (log-port (current-error-port)))
"Retrieve FILES from REMOTE and import them using the 'import-paths' RPC on "Retrieve FILES from REMOTE and import them using the 'import-paths' RPC on
LOCAL." LOCAL. When RECURSIVE? is true, retrieve the closure of FILES."
(let-values (((port count) (let-values (((port count)
(file-retrieval-port files remote))) (file-retrieval-port files remote
#:recursive? recursive?)))
(format #t (N_ "retrieving ~a store item from '~a'...~%" (format #t (N_ "retrieving ~a store item from '~a'...~%"
"retrieving ~a store items from '~a'...~%" count) "retrieving ~a store items from '~a'...~%" count)
count (remote-store-host remote)) count (remote-store-host remote))