Debugging recvFrom termination.

1 files changed, 9 insertions, 6 deletions

diff --git a/dht/src/Network/QueryResponse.hs b/dht/src/Network/QueryResponse.hs
index 27134470..8f3c078d 100644
--- a/dht/src/Network/QueryResponse.hs
+++ b/dht/src/Network/QueryResponse.hs
@@ -200,11 +200,11 @@ forkListener :: String -> Transport err addr x -> IO (IO ())
 forkListener name client = do
     thread_id <- forkIO $ do
         myThreadId >>= flip labelThread ("listener."++name)
-        fix $ awaitMessage client . const
+        fix $ \loop -> awaitMessage client $ maybe (return ()) (const loop)
         dput XMisc $ "Listener died: " ++ name
     return $ do
         closeTransport client
-        killThread thread_id
+        -- killThread thread_id
 
 asyncQuery_ :: Client err meth tid addr x
               -> MethodSerializer tid addr x meth a b
@@ -560,6 +560,7 @@ ignoreEOF sock isClosed def e = do
     done <- tryReadMVar isClosed
     case done of
         Just () -> do close sock
+                      dput XMisc "Closing UDP socket."
                       pure Nothing
         _ -> if isEOFError e then pure $ Just def
                              else throwIO e
@@ -584,11 +585,11 @@ saferSendTo sock bs saddr = void (B.sendTo sock bs saddr)
 -- argument is the listen-address for incoming packets.  This is a useful
 -- low-level 'Transport' that can be transformed for higher-level protocols
 -- using 'layerTransport'.
-udpTransport :: SockAddr -> IO (Transport err SockAddr ByteString)
+udpTransport :: Show err => SockAddr -> IO (Transport err SockAddr ByteString)
 udpTransport bind_address = fst <$> udpTransport' bind_address
 
 -- | Like 'udpTransport' except also returns the raw socket (for broadcast use).
-udpTransport' :: SockAddr -> IO (Transport err SockAddr ByteString, Socket)
+udpTransport' :: Show err => SockAddr -> IO (Transport err SockAddr ByteString, Socket)
 udpTransport' bind_address = do
   let family = sockAddrFamily bind_address
   sock <- socket family Datagram defaultProtocol
@@ -601,6 +602,7 @@ udpTransport' bind_address = do
       awaitMessage = \kont -> do
         r <- handle (ignoreEOF sock isClosed $ Right (B.empty, SockAddrInet 0 0)) $ do
                 Just . Right <$!> B.recvFrom sock udpBufferSize
+        dput XMisc $ "udp.awaitMessage.recvFrom: " ++ show r
         kont $! r
     , sendMessage = case family of
         AF_INET6 -> \case
@@ -618,8 +620,8 @@ udpTransport' bind_address = do
             addr4 -> \bs -> saferSendTo sock bs addr4
         _ -> \addr bs -> saferSendTo sock bs addr
     , closeTransport = do
-        -- close sock
-        tryTakeMVar isClosed >> putMVar isClosed ()
+        dput XMisc $ "closeTransport for udpTransport' called. " ++ show bind_address
+        tryPutMVar isClosed ()
         -- set O_NONBLOCK using fcntl
         -- NOTE: setNonBlockIfNeeded is a no-op on windows
 #if MIN_VERSION_network (3,1,0)
@@ -627,6 +629,7 @@ udpTransport' bind_address = do
 #else
         setNonBlockIfNeeded (fdSocket sock) -- setSocketOption sock ??? 0
 #endif
+        -- shutdown sock ShutdownBoth `catchIOError` \_ -> return ()
     }
   return (tr, sock)