offload: Comment out attempt to set up an lsh gateway.

* guix/scripts/offload.scm (open-ssh-gateway): Comment out.
  (process-request): Remove call to 'open-ssh-gateway' and to 'kill'.

1 files changed, 57 insertions, 59 deletions

diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm
index 5b971302f3..d5ee907c36 100644
--- a/guix/scripts/offload.scm
+++ b/guix/scripts/offload.scm
@@ -122,38 +122,40 @@ determined."
          (leave (_ "failed to load machine file '~a': ~s~%")
                 file args))))))
 
-(define (open-ssh-gateway machine)
-  "Initiate an SSH connection gateway to MACHINE, and return the PID of the
-running lsh gateway upon success, or #f on failure."
-  (catch 'system-error
-    (lambda ()
-      (let* ((port   (open-pipe* OPEN_READ %lsh-command
-                                 "-l" (build-machine-user machine)
-                                 "-i" (build-machine-private-key machine)
-                                 ;; XXX: With lsh 2.1, passing '--write-pid'
-                                 ;; last causes the PID not to be printed.
-                                 "--write-pid" "--gateway" "--background" "-z"
-                                 (build-machine-name machine)))
-             (line   (read-line port))
-             (status (close-pipe port)))
-       (if (zero? status)
-           (let ((pid (string->number line)))
-             (if (integer? pid)
-                 pid
-                 (begin
-                   (warning (_ "'~a' did not write its PID on stdout: ~s~%")
-                            %lsh-command line)
-                   #f)))
-           (begin
-             (warning (_ "failed to initiate SSH connection to '~a':\
- '~a' exited with ~a~%")
-                      (build-machine-name machine)
-                      %lsh-command
-                      (status:exit-val status))
-             #f))))
-    (lambda args
-      (leave (_ "failed to execute '~a': ~a~%")
-             %lsh-command (strerror (system-error-errno args))))))
+;;; FIXME: The idea was to open the connection to MACHINE once for all, but
+;;; lshg is currently non-functional.
+;; (define (open-ssh-gateway machine)
+;;   "Initiate an SSH connection gateway to MACHINE, and return the PID of the
+;; running lsh gateway upon success, or #f on failure."
+;;   (catch 'system-error
+;;     (lambda ()
+;;       (let* ((port   (open-pipe* OPEN_READ %lsh-command
+;;                                  "-l" (build-machine-user machine)
+;;                                  "-i" (build-machine-private-key machine)
+;;                                  ;; XXX: With lsh 2.1, passing '--write-pid'
+;;                                  ;; last causes the PID not to be printed.
+;;                                  "--write-pid" "--gateway" "--background" "-z"
+;;                                  (build-machine-name machine)))
+;;              (line   (read-line port))
+;;              (status (close-pipe port)))
+;;        (if (zero? status)
+;;            (let ((pid (string->number line)))
+;;              (if (integer? pid)
+;;                  pid
+;;                  (begin
+;;                    (warning (_ "'~a' did not write its PID on stdout: ~s~%")
+;;                             %lsh-command line)
+;;                    #f)))
+;;            (begin
+;;              (warning (_ "failed to initiate SSH connection to '~a':\
+;;  '~a' exited with ~a~%")
+;;                       (build-machine-name machine)
+;;                       %lsh-command
+;;                       (status:exit-val status))
+;;              #f))))
+;;     (lambda args
+;;       (leave (_ "failed to execute '~a': ~a~%")
+;;              %lsh-command (strerror (system-error-errno args))))))
 
 (define (remote-pipe machine mode command)
   "Run COMMAND on MACHINE, assuming an lsh gateway has been set up."
@@ -324,34 +326,30 @@ allowed on MACHINE."
                    (features features)))
          (machine (choose-build-machine reqs (build-machines))))
     (if machine
-        (match (open-ssh-gateway machine)
-          ((? integer? pid)
-           (display "# accept\n")
-           (let ((inputs  (string-tokenize (read-line)))
-                 (outputs (string-tokenize (read-line))))
-             (when (send-files (cons (derivation-file-name drv) inputs)
-                               machine)
-               (let ((status (offload drv machine
-                                      #:print-build-trace? print-build-trace?
-                                      #:max-silent-time max-silent-time
-                                      #:build-timeout build-timeout)))
-                 (kill pid SIGTERM)
-                 (if (zero? status)
-                     (begin
-                       (retrieve-files outputs machine)
-                       (format (current-error-port)
-                               "done with offloaded '~a'~%"
-                               (derivation-file-name drv)))
-                     (begin
-                       (format (current-error-port)
-                               "derivation '~a' offloaded to '~a' failed \
+        (begin
+          (display "# accept\n")
+          (let ((inputs  (string-tokenize (read-line)))
+                (outputs (string-tokenize (read-line))))
+            (when (send-files (cons (derivation-file-name drv) inputs)
+                              machine)
+              (let ((status (offload drv machine
+                                     #:print-build-trace? print-build-trace?
+                                     #:max-silent-time max-silent-time
+                                     #:build-timeout build-timeout)))
+                (if (zero? status)
+                    (begin
+                      (retrieve-files outputs machine)
+                      (format (current-error-port)
+                              "done with offloaded '~a'~%"
+                              (derivation-file-name drv)))
+                    (begin
+                      (format (current-error-port)
+                              "derivation '~a' offloaded to '~a' failed \
 with exit code ~a~%"
-                               (derivation-file-name drv)
-                               (build-machine-name machine)
-                               (status:exit-val status))
-                       (primitive-exit (status:exit-val status))))))))
-          (#f
-           (display "# decline\n")))
+                              (derivation-file-name drv)
+                              (build-machine-name machine)
+                              (status:exit-val status))
+                      (primitive-exit (status:exit-val status))))))))
         (display "# decline\n"))))
 
 (define-syntax-rule (with-nar-error-handling body ...)