kreyren/guix-kreyren
1
0
Fork 0
Code Issues 1 Pull Requests 1 Releases Activity

offload: Compress files being sent/retrieved.

Browse Source 
* guix/scripts/offload.scm (send-files): Add "xz -dc |" to the remote
  pipe command.  Pass PIPE through 'call-with-compressed-output-port'.
  Remove 'close-pipe' call.
  (retrieve-files): Add "| xz -c" to the remote pipe command.  Pass PIPE
  through 'call-with-decompressed-port'.  Remove 'close-pipe' call.
This commit is contained in:
Ludovic Courtès 2014-03-24 22:20:54 +01:00
parent 01ac19dca4
commit 8b7af63754
1 changed files with 22 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
guix/scripts/offload.scm
View File

@ -377,19 +377,22 @@ success, #f otherwise."
;; Compute the subset of FILES missing on MACHINE, and send them in
;; topologically sorted order so that they can actually be imported.
(let ((files (missing-files (topologically-sorted store files)))
(pipe (remote-pipe machine OPEN_WRITE
'("guix" "archive" "--import"))))
(let* ((files (missing-files (topologically-sorted store files)))
(pipe (remote-pipe machine OPEN_WRITE
'("xz" "-dc" "|"
"guix" "archive" "--import"))))
(format #t (_ "sending ~a store files to '~a'...~%")
(length files) (build-machine-name machine))
(catch 'system-error
(lambda ()
(export-paths store files pipe))
(lambda args
(warning (_ "failed while exporting files to '~a': ~a~%")
(build-machine-name machine)
(strerror (system-error-errno args)))))
(zero? (close-pipe pipe))))))
(call-with-compressed-output-port 'xz pipe
(lambda (compressed)
(catch 'system-error
(lambda ()
(export-paths store files compressed))
(lambda args
(warning (_ "failed while exporting files to '~a': ~a~%")
(build-machine-name machine)
(strerror (system-error-errno args)))))))
#t))))
(define (retrieve-files files machine)
"Retrieve FILES from MACHINE's store, and import them."
@ -397,7 +400,8 @@ success, #f otherwise."
(build-machine-name machine))
(let ((pipe (remote-pipe machine OPEN_READ
`("guix" "archive" "--export" ,@files))))
`("guix" "archive" "--export" ,@files
"|" "xz" "-c"))))
(and pipe
(with-store store
(guard (c ((nix-protocol-error? c)
@ -409,11 +413,13 @@ success, #f otherwise."
;; We cannot use the 'import-paths' RPC here because we already
;; hold the locks for FILES.
(restore-file-set pipe
#:log-port (current-error-port)
#:lock? #f)
(call-with-decompressed-port 'xz pipe
(lambda (decompressed)
(restore-file-set decompressed
#:log-port (current-error-port)
#:lock? #f)))
(zero? (close-pipe pipe)))))))
#t)))))
;;;