Exploit thread-dead?, rather than tracking it ourselves.

ssh-session.rkt

@@ -949,24 +949,27 @@
     (close-out)
     'done)
   (let loop ((oob-queue (make-queue))
-	     (remaining-credit 0)
+	     (remaining-credit 0))
-	     (channel-thread-alive #t))
+    (define channel-thread-dead (thread-dead? channel-thread))
     (sync (if (queue-empty? oob-queue)
 	      never-evt
 	      (let-values (((first rest) (dequeue oob-queue)))
 		(handle-evt (channel-put-evt oob-ch first)
-			    (lambda (dummy) (loop rest remaining-credit channel-thread-alive)))))
+			    (lambda (dummy) (loop rest remaining-credit)))))
-	  (if channel-thread-alive
+	  (if channel-thread-dead
+	      never-evt
 	      (handle-evt (thread-dead-evt channel-thread)
 			  (lambda (dummy)
 			    (when (not (port-closed? app-out-port))
+			      ;; If the thread died without closing its output-port, do
+			      ;; that here. That way we get to drain the port before
+			      ;; terminating ourselves.
 			      (close-output-port app-out-port))
-			    (loop oob-queue remaining-credit #f)))
+			    (loop oob-queue remaining-credit))))
-	      never-evt)
 	  (if (port-closed? in)
-	      (if channel-thread-alive
+	      (if channel-thread-dead
-		  never-evt
+		  (handle-evt always-evt (lambda (dummy) (close-ports)))
-		  (handle-evt always-evt (lambda (dummy) (close-ports))))
+		  never-evt)
 	      (if (positive? remaining-credit)
 		  (let ((buffer (make-bytes (min (channel-io-transfer-buffer-size)
 						 remaining-credit))))
@@ -974,34 +977,28 @@
 				(lambda (count)
 				  (if (eof-object? count)
 				      (begin (close-in)
-					     (if channel-thread-alive
+					     (if channel-thread-dead
-						 (loop oob-queue
+						 (close-ports)
-						       remaining-credit
+						 (loop oob-queue remaining-credit)))
-						       channel-thread-alive)
-						 (close-ports)))
 				      (begin (send handle say
 						   `(data ,(sub-bit-string buffer 0 (* 8 count))))
-					     (loop oob-queue
+					     (loop oob-queue (- remaining-credit count)))))))
-						   (- remaining-credit count)
-						   channel-thread-alive))))))
 		  never-evt))
 	  (handle-evt (send handle listen-evt)
 		      (match-lambda
 		       ((arrived _)
-			(loop oob-queue remaining-credit channel-thread-alive))
+			(loop oob-queue remaining-credit))
 		       ((departed _ _)
 			(close-ports))
 		       ((says _ (credit _ amount) _)
-			(loop oob-queue (+ remaining-credit amount) channel-thread-alive))
+			(loop oob-queue (+ remaining-credit amount)))
 		       ((says _ `(data ,data) _)
 			(write-bytes data out)
 			;; TODO: propagate backpressure through pipes
 			(send handle say (credit 'session (bytes-length data)))
-			(loop oob-queue remaining-credit channel-thread-alive))
+			(loop oob-queue remaining-credit))
 		       ((says _ (and notification `(notify ,type ,data)) _)
-			(loop (enqueue oob-queue notification)
+			(loop (enqueue oob-queue notification) remaining-credit))
-			      remaining-credit
-			      channel-thread-alive))
 		       ((says _ (rpc-request reply-to id message) _)
 			(loop (enqueue oob-queue
 				       `(request ,message
@@ -1009,8 +1006,7 @@
 						    (send handle say
 							  (rpc-reply id answer)
 							  reply-to))))
-			      remaining-credit
+			      remaining-credit)))))))
-			      channel-thread-alive)))))))
 
 (define (start-app-channel channel-main)
   (define channel-room (make-room 'channel))