diff options
author | Ludovic Courtès <ludo@gnu.org> | 2018-01-12 23:32:25 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2018-01-12 23:41:15 +0100 |
commit | 0dcf675c56a4649ccef657e78849e91f9f9b4c0a (patch) | |
tree | a563cae4258b221701ff49e0cbc511d918a8b1d4 /guix/ssh.scm | |
parent | 4eb0f9ae05a9bf20fb91c49b39bebc687265c5e5 (diff) | |
download | gnu-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.scm | 40 |
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))))))) |