03/03: copy, offload: Explicitly close SSH channels and sessions.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit 61fe9ced7da7eefceb931af0cb7363b721f5bdd6
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Sat Aug 29 16:05:05 2020 +0200

    copy, offload: Explicitly close SSH channels and sessions.
    
    Fixes <https://bugs.gnu.org/42740>.
    
    * guix/scripts/copy.scm (send-to-remote-host): Keep the result of
    'connect-to-remote-daemon' in scope, and explicitly close it after the
    call to 'send-files'.
    (retrieve-from-remote-host): Explicitly close REMOTE and disconnect
    SESSION.
    * guix/scripts/offload.scm (transfer-and-offload): Explicitly close
    STORE and disconnect SESSION upon completion.
---
 guix/scripts/copy.scm    | 8 ++++++--
 guix/scripts/offload.scm | 2 ++
 2 files changed, 8 insertions(+), 2 deletions(-)

diff --git a/guix/scripts/copy.scm b/guix/scripts/copy.scm
index 16d2de3..274620f 100644
--- a/guix/scripts/copy.scm
+++ b/guix/scripts/copy.scm
@@ -20,6 +20,7 @@
   #:use-module (guix ui)
   #:use-module (guix scripts)
   #:use-module (guix ssh)
+  #:use-module ((ssh session) #:select (disconnect!))
   #:use-module (guix store)
   #:use-module ((guix status) #:select (with-status-verbosity))
   #:use-module (guix utils)
@@ -71,9 +72,10 @@ package names, build the underlying packages before sending 
them."
     (and (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)
+                (remote  (connect-to-remote-daemon session))
+                (sent    (send-files local items remote
                                      #:recursive? #t)))
+           (close-connection remote)
            (format #t "~{~a~%~}" sent)
            sent))))
 
@@ -93,6 +95,8 @@ package names, build the underlying packages before sending 
them."
                    (options->derivations+files local opts))
                   ((retrieved)
                    (retrieve-files local items remote #:recursive? #t)))
+      (close-connection remote)
+      (disconnect! session)
       (format #t "~{~a~%~}" retrieved)
       retrieved)))
 
diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm
index a56701f..1e0e9d7 100644
--- a/guix/scripts/offload.scm
+++ b/guix/scripts/offload.scm
@@ -365,6 +365,8 @@ of free disk space on '~a'~%")
                                        #:log-port (current-error-port)
                                        #:lock? #f)))
 
+  (close-connection store)
+  (disconnect! session)
   (format (current-error-port) "done with offloaded '~a'~%"
           (derivation-file-name drv)))