diff options
author | Ludovic Courtès <ludo@gnu.org> | 2018-01-10 17:52:23 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2018-01-11 00:00:02 +0100 |
commit | 17af5d51de7c40756a4a39d336f81681de2ba447 (patch) | |
tree | 0266b933a2b68e79b780935e52e50869695ff470 | |
parent | 74a235525410083bf02d3f3e495eca9adb0db2c8 (diff) | |
download | guix-17af5d51de7c40756a4a39d336f81681de2ba447.tar.gz |
ssh: Work around 'get-bytevector-some' bug.
This works around <https://bugs.gnu.org/30066> and noticeably improves performance when using GUIX_DAEMON_SOCKET=ssh://HOST (the redirect code was transferring data to guix-daemon one byte at a time!). * guix/ssh.scm (remote-daemon-channel)[redirect]: Define 'read!' and use it instead of 'get-bytevector-some'.
-rw-r--r-- | guix/ssh.scm | 33 |
1 files changed, 23 insertions, 10 deletions
diff --git a/guix/ssh.scm b/guix/ssh.scm index 469f4fa6c1..96e4af9179 100644 --- a/guix/ssh.scm +++ b/guix/ssh.scm @@ -101,11 +101,24 @@ Throw an error on failure." ;; Unix-domain sockets but libssh doesn't have an API for that, hence this ;; hack. `(begin - (use-modules (ice-9 match) (rnrs io ports)) + (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))))) (let ((sock (socket AF_UNIX SOCK_STREAM 0)) (stdin (current-input-port)) - (stdout (current-output-port))) + (stdout (current-output-port)) + (buffer (make-bytevector 65536))) (setvbuf stdin _IONBF) (setvbuf stdout _IONBF) (connect sock AF_UNIX ,socket-name) @@ -114,17 +127,17 @@ Throw an error on failure." (match (select (list stdin sock) '() (list stdin stdout sock)) ((reads writes ()) (when (memq stdin reads) - (match (get-bytevector-some stdin) - ((? eof-object?) + (match (read! stdin buffer) + ((? zero?) ;EOF (primitive-exit 0)) - (bv - (put-bytevector sock bv)))) + (count + (put-bytevector sock buffer 0 count)))) (when (memq sock reads) - (match (get-bytevector-some sock) - ((? eof-object?) + (match (read! sock buffer) + ((? zero?) ;EOF (primitive-exit 0)) - (bv - (put-bytevector stdout bv)))) + (count + (put-bytevector stdout buffer 0 count)))) (loop)) (_ (primitive-exit 1))))))) |