From f1494de13c89d821bdf1a6d9e9f08bd8e191c9e0 Mon Sep 17 00:00:00 2001 From: "Artyom V. Poptsov" Date: Tue, 3 Jan 2017 20:07:35 +0300 Subject: tunnel.scm (main-loop): Handle "interrupted system call" errors * modules/ssh/tunnel.scm (main-loop): Handle "interrupted system call" errors. --- modules/ssh/tunnel.scm | 30 +++++++++++++++++------------- 1 file changed, 17 insertions(+), 13 deletions(-) diff --git a/modules/ssh/tunnel.scm b/modules/ssh/tunnel.scm index 99bdbb7..8693c46 100644 --- a/modules/ssh/tunnel.scm +++ b/modules/ssh/tunnel.scm @@ -193,19 +193,23 @@ when no data is available." (timeout-s (and timeout (quotient timeout 1000000))) (timeout-us (and timeout (remainder timeout 1000000)))) (while (connected? (tunnel-session tunnel)) - (let* ((channel (tunnel-open-forward-channel tunnel)) - (client-connection (accept sock)) - (client (car client-connection))) - - (while (channel-open? channel) - (cond-io - (client -> channel => transfer) - (channel -> client => transfer) - (else - (let ((selected (select (list client) '() '() - timeout-s timeout-us))) - (and (null? (car selected)) - (idle-proc client channel)))))))))) + (catch #t + (lambda () + (let* ((channel (tunnel-open-forward-channel tunnel)) + (client-connection (accept sock)) + (client (car client-connection))) + + (while (channel-open? channel) + (cond-io + (client -> channel => transfer) + (channel -> client => transfer) + (else + (let ((selected (select (list client) '() '() + timeout-s timeout-us))) + (and (null? (car selected)) + (idle-proc client channel)))))))) + (const #t))))) + (define (main-loop/reverse tunnel idle-proc) (let* ((timeout (tunnel-timeout tunnel)) -- cgit v1.2.3