From 0c05a400f82f9ebe1fdcb28e01faf599fdd8277c Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Fri, 4 Nov 2011 13:57:42 -0400 Subject: [PATCH] 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. --- cook-port.rkt | 52 ++++++++++++++++++++++++++++--------------------- ssh-service.rkt | 6 +++++- 2 files changed, 35 insertions(+), 23 deletions(-) diff --git a/cook-port.rkt b/cook-port.rkt index d1cda94..fc3ca65 100644 --- a/cook-port.rkt +++ b/cook-port.rkt @@ -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) diff --git a/ssh-service.rkt b/ssh-service.rkt index 5912093..065eb00 100644 --- a/ssh-service.rkt +++ b/ssh-service.rkt @@ -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)