Fix bugs in port-closure-detection logic.

To begin with, I was looking at closure of the wrong port. Fixing
that, however, still left me with the problem that there was no event
for closure of the downstream port that I could use, so the
input-cooker has to poll to see if downstream has indicated that it
should be shut down. Finally, the actual port-closing code was doing
different things in different cases, so I've straightened that out as
well, and there was a race between closing raw-out in the
output-cooker and writing some feedback to it in the input-cooker, so
I've added a with-handlers to ignore write errors in the input-cooker.
This commit is contained in:
Tony Garnock-Jones 2011-11-04 13:57:42 -04:00
parent cf7563e5ed
commit 0c05a400f8
2 changed files with 35 additions and 23 deletions

View File

@ -43,32 +43,40 @@
(define (cook-io raw-in raw-out prompt)
(define-values (cooked-in cooked-out) (make-pipe))
(define (close-ports)
(close-output-port cooked-out) ;; signal to our reader that we're not sending more
(close-input-port raw-in)) ;; signal to upstream that we are done reading
(thread
(lambda ()
(define input-buffer (make-bytes 4096))
(let loop ((b (buffer '() #f)))
(if (port-closed? cooked-out)
;; our job here is
'done
(let ((count (read-bytes-avail! input-buffer raw-in)))
(if (eof-object? count)
(begin (close-output-port cooked-out)
(loop b))
(let process-bytes ((i 0) (b b))
(if (>= i count)
(loop b)
(update-buffer b (integer->char (bytes-ref input-buffer i)) prompt
(lambda ()
(close-output-port cooked-out)
(close-input-port raw-in))
(lambda (line new-b)
(write-string "\r\n" raw-out)
(write-string line cooked-out)
(newline cooked-out)
(process-bytes (+ i 1) new-b))
(lambda (new-b feedback)
(write-string feedback raw-out)
(process-bytes (+ i 1) new-b)))))))))))
(if (port-closed? cooked-in)
;; The ultimate reader of our cooked output has closed
;; their input port. We are therefore done.
(close-ports)
;; TODO: remove polling for port-closed when we get port-closed-evt
(let ((count (sync/timeout 0.5 (read-bytes-avail!-evt input-buffer raw-in))))
(cond
((eof-object? count) ;; end-of-file on input
(close-ports))
((eq? count #f) ;; timeout - poll to see if cooked-out has been closed
(loop b))
(else ;; a number - count of bytes read
(let process-bytes ((i 0) (b b))
(if (>= i count)
(loop b)
(update-buffer b (integer->char (bytes-ref input-buffer i)) prompt
close-ports
(lambda (line new-b)
(with-handlers ((exn:fail? void)) ;; ignore write errors
(write-string "\r\n" raw-out))
(write-string line cooked-out)
(newline cooked-out)
(process-bytes (+ i 1) new-b))
(lambda (new-b feedback)
(with-handlers ((exn:fail? void)) ;; ignore write errors
(write-string feedback raw-out))
(process-bytes (+ i 1) new-b))))))))))))
(values cooked-in (cook-output raw-out)))
(define (cook-output raw-out)

View File

@ -52,7 +52,11 @@
(define finished-writing? (port-closed? out))
(if (and finished-reading? finished-writing?)
'closed
(sync (if (queue-empty? oob-queue)
(sync (handle-evt (alarm-evt (+ (current-inexact-milliseconds) 500))
;; TODO: remove polling for port-closed when we get port-closed-evt
(lambda (dummy)
(loop oob-queue remaining-credit)))
(if (queue-empty? oob-queue)
never-evt
(let-values (((first rest) (dequeue oob-queue)))
(handle-evt (channel-put-evt oob-ch first)