Changeset 39074 in project for release/4/vandusen/trunk/vandusen-remote.scm

Timestamp:

10/28/20 22:03:44 (3 months ago)

Author:

Moritz Heidkamp

Message:

vandusen-remote: Handle timeout errors from tcp-accept

File:

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

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

@@ -19 +19 @@
                                             (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)))))))))
+                                 (condition-case
+                                     (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))
+                                   (e (exn i/o net timeout)
+                                      (print "tcp-accept timed out")
+                                      (loop)))))))))
 
 )