Changeset 39071 in project

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:

• release/4/vandusen/trunk/vandusen-remote.scm (modified) (1 diff)

release/4/vandusen/trunk/vandusen-remote.scm

@@ -7 +7 @@
 
 (plugin 'remote
-        (lambda ()
-          (let ((listener (tcp-listen ($ 'remote-port)
+        (lambda ()
+          (let ((listener (tcp-listen ($ 'remote-port)
                                       (or ($ 'remote-backlog) 10)
                                       (or ($ 'remote-host) "localhost"))))
-            (add-finalizer (lambda ()
-                             (debug "finalizing remote listener")
-                             (tcp-close listener)))
+            (add-finalizer (lambda ()
+                             (debug "finalizing remote listener")
+                             (tcp-close listener)))
 
-            (thread-start! (lambda ()
-                             (let loop ()
-                               (receive (in out) (tcp-accept listener)
-                                 (thread-start! (lambda ()
-                                                  (let ((line (read-line in)))
-                                                    (and-let* ((match (irregex-match 
-                                                                       '(seq (submatch (+ (~ space)))
-                                                                             " " 
-                                                                             (submatch (+ any)))
-                                                                       line)))
-                                                      (say (string-trim (irregex-match-substring match 2))
-                                                           (irregex-match-substring match 1))))
-                                                  (close-input-port in)
-                                                  (close-output-port out)))
-                                 (loop)))))))))
+            (thread-start! (lambda ()
+                             (parameterize ((tcp-accept-timeout 10000)
+                                            (tcp-read-timeout 3000))
+                               (let loop ()
+                                 (receive (in out) (tcp-accept listener)
+                                          (thread-start! (lambda ()
+                                                           (dynamic-wind
+                                                               void
+                                                               (lambda ()
+                                                                 (let ((line (read-line in)))
+                                                                   (and-let* ((match (irregex-match
+                                                                                      '(seq (submatch (+ (~ space)))
+                                                                                            " "
+                                                                                            (submatch (+ any)))
+                                                                                      line)))
+                                                                     (say (string-trim (irregex-match-substring match 2))
+                                                                          (irregex-match-substring match 1)))))
+                                                               (lambda ()
+                                                                 (close-input-port in)
+                                                                 (close-output-port out)))))
+                                          (loop)))))))))
+
+)