From 0dcf675c56a4649ccef657e78849e91f9f9b4c0a Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Fri, 12 Jan 2018 23:32:25 +0100
Subject: ssh: Switch back to 'get-bytevector-some'.

This mostly reverts 17af5d51de7c40756a4a39d336f81681de2ba447.
Suggested by Andy Wingo <wingo@igalia.com>.

* guix/ssh.scm (remote-daemon-channel)[redirect]: Remove 'read!' FFI
hack.  Use buffered ports.
---
 guix/ssh.scm | 40 +++++++++++++++++-----------------------
 1 file changed, 17 insertions(+), 23 deletions(-)

(limited to 'guix')

diff --git a/guix/ssh.scm b/guix/ssh.scm
index 4dcc6d38bb..5e442024bc 100644
--- a/guix/ssh.scm
+++ b/guix/ssh.scm
@@ -106,42 +106,36 @@ (define redirect
     ;; hack.
     `(begin
        (use-modules (ice-9 match) (rnrs io ports)
-                    (rnrs bytevectors) (system foreign))
-
-       (define read!
-         ;; XXX: We would use 'get-bytevector-some' but it always returns a
-         ;; single byte in Guile <= 2.2.3---see <https://bugs.gnu.org/30066>.
-         ;; This procedure works around it.
-         (let ((proc (pointer->procedure int
-                                         (dynamic-func "read" (dynamic-link))
-                                         (list int '* size_t))))
-           (lambda (port bv)
-             (proc (fileno port) (bytevector->pointer bv)
-                   (bytevector-length bv)))))
+                    (rnrs bytevectors))
 
        (let ((sock   (socket AF_UNIX SOCK_STREAM 0))
              (stdin  (current-input-port))
-             (stdout (current-output-port))
-             (buffer (make-bytevector 65536)))
-         (setvbuf stdin _IONBF)
+             (stdout (current-output-port)))
          (setvbuf stdout _IONBF)
+
+         ;; Use buffered ports so that 'get-bytevector-some' returns up to the
+         ;; whole buffer like read(2) would--see <https://bugs.gnu.org/30066>.
+         (setvbuf stdin _IOFBF 65536)
+         (setvbuf sock _IOFBF 65536)
+
          (connect sock AF_UNIX ,socket-name)
 
          (let loop ()
            (match (select (list stdin sock) '() '())
              ((reads () ())
               (when (memq stdin reads)
-                (match (read! stdin buffer)
-                  ((? zero?)                      ;EOF
+                (match (get-bytevector-some stdin)
+                  ((? eof-object?)
                    (primitive-exit 0))
-                  (count
-                   (put-bytevector sock buffer 0 count))))
+                  (bv
+                   (put-bytevector sock bv)
+                   (force-output sock))))
               (when (memq sock reads)
-                (match (read! sock buffer)
-                  ((? zero?)                      ;EOF
+                (match (get-bytevector-some sock)
+                  ((? eof-object?)
                    (primitive-exit 0))
-                  (count
-                   (put-bytevector stdout buffer 0 count))))
+                  (bv
+                   (put-bytevector stdout bv))))
               (loop))
              (_
               (primitive-exit 1)))))))
-- 
cgit v1.2.3