relaySession exception handler.

2 files changed, 5 insertions, 3 deletions

diff --git a/dht/src/Network/Tox/Relay.hs b/dht/src/Network/Tox/Relay.hs
index b315648a..6a1f04fa 100644
--- a/dht/src/Network/Tox/Relay.hs
+++ b/dht/src/Network/Tox/Relay.hs
@@ -273,7 +273,9 @@ tcpRelay crypto udp_addr sendOnion = do
     bany   <- getBindAddress ""      True
     h <- forkStreamServer ServerConfig
                         { serverWarn    = dput XMisc
-                        , serverSession = relaySession crypto clients cons sendOnion
+                        , serverSession = \s n h -> relaySession crypto clients cons sendOnion s n h
+                                            `catchIOError` \e -> do
+                                                dput XRelay $ "relaySession died: " ++ show e
                         }
                       [b443,b80,b3389,udp_addr,b33445,bany]
     return (h,sendTCP_ clients)
diff --git a/server/src/Network/StreamServer.hs b/server/src/Network/StreamServer.hs
index c60ba99d..8ebdf678 100644
--- a/server/src/Network/StreamServer.hs
+++ b/server/src/Network/StreamServer.hs
@@ -148,7 +148,7 @@ forkStreamServer cfg addrs0 = do
     listen sock maxListenQueue
     thread <- mkWeakThreadId <=< forkIO $ do
         bindaddr <- Socket.getSocketName sock
-        myThreadId >>= flip labelThread ("StreamServer.acceptLoop." <> bshow bindaddr)
+        myThreadId >>= flip labelThread ("stream.acceptLoop." <> bshow bindaddr)
         acceptLoop cfg sock 0
     return (ServerHandle sock thread)
 
@@ -162,7 +162,7 @@ acceptLoop cfg sock n = handle (acceptException cfg n sock) $ do
     laddr <- Socket.getSocketName con
     h <- socketToHandle con ReadWriteMode
     forkIO $ do
-        myThreadId >>= flip labelThread "StreamServer.session"
+        myThreadId >>= flip labelThread ("stream.session." ++ show (canonize raddr))
         serverSession cfg (restrictHandleSocket h con, (Local laddr, Remote raddr)) conkey h
     acceptLoop cfg sock (n + 1)