mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-12-27 14:52:05 -05:00
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:
parent
4eb0f9ae05
commit
0dcf675c56
1 changed files with 17 additions and 23 deletions
40
guix/ssh.scm
40
guix/ssh.scm
|
@ -106,42 +106,36 @@ (define redirect
|
||||||
;; 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)))))))
|
||||||
|
|
Loading…
Reference in a new issue