ssh: Work around 'select' bug in Guile.

Fixes <https://bugs.gnu.org/30365>.

* guix/ssh.scm (remote-daemon-channel)[redirect]: Define 'select*' and
use it.
This commit is contained in:
Ludovic Courtès 2018-02-07 22:31:48 +01:00
parent a76acfd3f5
commit 8446dc5a36
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 13 additions and 4 deletions

View File

@ -110,7 +110,16 @@ Throw an error on failure."
(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))
(select* (lambda (read write except)
;; This is a workaround for
;; <https://bugs.gnu.org/30365> in Guile < 2.2.4:
;; since 'select' sometimes returns non-empty sets for
;; no good reason, call 'select' a second time with a
;; zero timeout to filter out incorrect replies.
(match (select read write except)
((read write except)
(select read write except 0))))))
(setvbuf stdout _IONBF) (setvbuf stdout _IONBF)
;; Use buffered ports so that 'get-bytevector-some' returns up to the ;; Use buffered ports so that 'get-bytevector-some' returns up to the
@ -121,7 +130,7 @@ Throw an error on failure."
(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 (get-bytevector-some stdin) (match (get-bytevector-some stdin)