From 61fe9ced7da7eefceb931af0cb7363b721f5bdd6 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Sat, 29 Aug 2020 16:05:05 +0200
Subject: 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 16d2de30f7..274620fc1e 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 a56701f07a..1e0e9d7905 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)))
 
-- 
cgit 1.4.1