diff options
| author | Artyom V. Poptsov <poptsov.artyom@gmail.com> | 2017-05-03 01:59:36 +0300 |
|---|---|---|
| committer | Artyom V. Poptsov <poptsov.artyom@gmail.com> | 2017-05-03 01:59:36 +0300 |
| commit | 8ad4e9eae8a2df60fb6e055dc3ea5ec6a3d7a5d6 (patch) | |
| tree | 483fd62939875179113f08fa5b56220f8e495054 /modules | |
| parent | tunnel.scm (main-loop/reverse): Improve the code a bit (diff) | |
| download | guile-ssh-8ad4e9eae8a2df60fb6e055dc3ea5ec6a3d7a5d6.tar.gz | |
tunnel.scm (tunnel-timeout/s+us): New procedure.
* modules/ssh/tunnel.scm (tunnel-timeout/s+us): New procedure.
(main-loop): Use it.
Diffstat (limited to 'modules')
| -rw-r--r-- | modules/ssh/tunnel.scm | 23 |
1 files changed, 15 insertions, 8 deletions
diff --git a/modules/ssh/tunnel.scm b/modules/ssh/tunnel.scm index fef4591..53f65ec 100644 --- a/modules/ssh/tunnel.scm +++ b/modules/ssh/tunnel.scm @@ -30,6 +30,7 @@ #:use-module (rnrs io ports) #:use-module (srfi srfi-9) #:use-module (srfi srfi-9 gnu) + #:use-module (srfi srfi-11) #:use-module (ice-9 receive) #:use-module (rnrs bytevectors) #:use-module (ssh session) @@ -182,6 +183,12 @@ the PORT-1 returns EOF." (close port-1) (close port-2))))) +(define (tunnel-timeout/s+us tunnel) + "Get a TUNNEL timeout as two values: timeout in seconds and microseconds." + (let ((timeout (tunnel-timeout tunnel))) + (values (and timeout (quotient timeout 1000000)) + (and timeout (remainder timeout 1000000))))) + (define (main-loop tunnel sock idle-proc) "Start the main loop of a TUNNEL. Accept connections on SOCK, transfer data between SOCK and the remote side. Call IDLE-PROC as @@ -189,25 +196,25 @@ between SOCK and the remote side. Call IDLE-PROC as (idle-proc client-socket channel) when no data is available." - (let* ((timeout (tunnel-timeout tunnel)) - (timeout-s (and timeout (quotient timeout 1000000))) - (timeout-us (and timeout (remainder timeout 1000000)))) + (let-values (((timeout-s timeout-us) (tunnel-timeout/s+us tunnel))) + + (define (select-client client) + (select (list client) '() '() timeout-s timeout-us)) + (while (connected? (tunnel-session tunnel)) (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)))))))) + (let ((selected (select-client client))) + (when (null? (car selected)) + (idle-proc client channel)))))))) (const #t))))) |