summaryrefslogtreecommitdiff
path: root/guix/ssh.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2018-01-12 23:32:25 +0100
committerLudovic Courtès <ludo@gnu.org>2018-01-12 23:41:15 +0100
commit0dcf675c56a4649ccef657e78849e91f9f9b4c0a (patch)
treea563cae4258b221701ff49e0cbc511d918a8b1d4 /guix/ssh.scm
parent4eb0f9ae05a9bf20fb91c49b39bebc687265c5e5 (diff)
downloadgnu-guix-0dcf675c56a4649ccef657e78849e91f9f9b4c0a.tar
gnu-guix-0dcf675c56a4649ccef657e78849e91f9f9b4c0a.tar.gz
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.
Diffstat (limited to 'guix/ssh.scm')
-rw-r--r--guix/ssh.scm40
1 files changed, 17 insertions, 23 deletions
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 @@ Throw an error on failure."
;; 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)))))))