ssh: Switch back to 'get-bytevector-some'.

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

* guix/ssh.scm (remote-daemon-channel)[redirect]: Remove 'read!' FFI
hack.  Use buffered ports.
This commit is contained in:
Ludovic Courtès 2018-01-12 23:32:25 +01:00
parent 4eb0f9ae05
commit 0dcf675c56
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 17 additions and 23 deletions

View File

@ -106,42 +106,36 @@ Throw an error on failure."
;; hack. ;; hack.
`(begin `(begin
(use-modules (ice-9 match) (rnrs io ports) (use-modules (ice-9 match) (rnrs io ports)
(rnrs bytevectors) (system foreign)) (rnrs bytevectors))
(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)))))
(let ((sock (socket AF_UNIX SOCK_STREAM 0)) (let ((sock (socket AF_UNIX SOCK_STREAM 0))
(stdin (current-input-port)) (stdin (current-input-port))
(stdout (current-output-port)) (stdout (current-output-port)))
(buffer (make-bytevector 65536)))
(setvbuf stdin _IONBF)
(setvbuf stdout _IONBF) (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) (connect sock AF_UNIX ,socket-name)
(let loop () (let loop ()
(match (select (list stdin sock) '() '()) (match (select (list stdin sock) '() '())
((reads () ()) ((reads () ())
(when (memq stdin reads) (when (memq stdin reads)
(match (read! stdin buffer) (match (get-bytevector-some stdin)
((? zero?) ;EOF ((? eof-object?)
(primitive-exit 0)) (primitive-exit 0))
(count (bv
(put-bytevector sock buffer 0 count)))) (put-bytevector sock bv)
(force-output sock))))
(when (memq sock reads) (when (memq sock reads)
(match (read! sock buffer) (match (get-bytevector-some sock)
((? zero?) ;EOF ((? eof-object?)
(primitive-exit 0)) (primitive-exit 0))
(count (bv
(put-bytevector stdout buffer 0 count)))) (put-bytevector stdout bv))))
(loop)) (loop))
(_ (_
(primitive-exit 1))))))) (primitive-exit 1)))))))