Changeset 39071 in project


Ignore:
Timestamp:
10/28/20 12:09:00 (5 weeks ago)
Author:
Moritz Heidkamp
Message:

vandusen-remote: Always close ports after having accepted a connection (i.e. also in error cases). Also, use some shorter timeouts - the defaults are unnecesserily generous for this use case.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • release/4/vandusen/trunk/vandusen-remote.scm

    r30305 r39071  
    77
    88(plugin 'remote
    9         (lambda ()
    10           (let ((listener (tcp-listen ($ 'remote-port)
     9        (lambda ()
     10          (let ((listener (tcp-listen ($ 'remote-port)
    1111                                      (or ($ 'remote-backlog) 10)
    1212                                      (or ($ 'remote-host) "localhost"))))
    13             (add-finalizer (lambda ()
    14                              (debug "finalizing remote listener")
    15                              (tcp-close listener)))
     13            (add-finalizer (lambda ()
     14                             (debug "finalizing remote listener")
     15                             (tcp-close listener)))
    1616
    17             (thread-start! (lambda ()
    18                              (let loop ()
    19                                (receive (in out) (tcp-accept listener)
    20                                  (thread-start! (lambda ()
    21                                                   (let ((line (read-line in)))
    22                                                     (and-let* ((match (irregex-match
    23                                                                        '(seq (submatch (+ (~ space)))
    24                                                                              " "
    25                                                                              (submatch (+ any)))
    26                                                                        line)))
    27                                                       (say (string-trim (irregex-match-substring match 2))
    28                                                            (irregex-match-substring match 1))))
    29                                                   (close-input-port in)
    30                                                   (close-output-port out)))
    31                                  (loop)))))))))
     17            (thread-start! (lambda ()
     18                             (parameterize ((tcp-accept-timeout 10000)
     19                                            (tcp-read-timeout 3000))
     20                               (let loop ()
     21                                 (receive (in out) (tcp-accept listener)
     22                                          (thread-start! (lambda ()
     23                                                           (dynamic-wind
     24                                                               void
     25                                                               (lambda ()
     26                                                                 (let ((line (read-line in)))
     27                                                                   (and-let* ((match (irregex-match
     28                                                                                      '(seq (submatch (+ (~ space)))
     29                                                                                            " "
     30                                                                                            (submatch (+ any)))
     31                                                                                      line)))
     32                                                                     (say (string-trim (irregex-match-substring match 2))
     33                                                                          (irregex-match-substring match 1)))))
     34                                                               (lambda ()
     35                                                                 (close-input-port in)
     36                                                                 (close-output-port out)))))
     37                                          (loop)))))))))
     38
     39)
Note: See TracChangeset for help on using the changeset viewer.