ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-27 14:52:05 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

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

Browse source 
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
Show stats Download patch file Download diff file Expand all files Collapse all files

40
guix/ssh.scm
View file

@ -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)))))))