summaryrefslogtreecommitdiff
path: root/dht/src
diff options
context:
space:
mode:
Diffstat (limited to 'dht/src')
-rw-r--r--dht/src/Network/QueryResponse.hs15
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 ())
200forkListener name client = do 200forkListener name client = do
201 thread_id <- forkIO $ do 201 thread_id <- forkIO $ do
202 myThreadId >>= flip labelThread ("listener."++name) 202 myThreadId >>= flip labelThread ("listener."++name)
203 fix $ awaitMessage client . const 203 fix $ \loop -> awaitMessage client $ maybe (return ()) (const loop)
204 dput XMisc $ "Listener died: " ++ name 204 dput XMisc $ "Listener died: " ++ name
205 return $ do 205 return $ do
206 closeTransport client 206 closeTransport client
207 killThread thread_id 207 -- killThread thread_id
208 208
209asyncQuery_ :: Client err meth tid addr x 209asyncQuery_ :: Client err meth tid addr x
210 -> MethodSerializer tid addr x meth a b 210 -> MethodSerializer tid addr x meth a b
@@ -560,6 +560,7 @@ ignoreEOF sock isClosed def e = do
560 done <- tryReadMVar isClosed 560 done <- tryReadMVar isClosed
561 case done of 561 case done of
562 Just () -> do close sock 562 Just () -> do close sock
563 dput XMisc "Closing UDP socket."
563 pure Nothing 564 pure Nothing
564 _ -> if isEOFError e then pure $ Just def 565 _ -> if isEOFError e then pure $ Just def
565 else throwIO e 566 else throwIO e
@@ -584,11 +585,11 @@ saferSendTo sock bs saddr = void (B.sendTo sock bs saddr)
584-- argument is the listen-address for incoming packets. This is a useful 585-- argument is the listen-address for incoming packets. This is a useful
585-- low-level 'Transport' that can be transformed for higher-level protocols 586-- low-level 'Transport' that can be transformed for higher-level protocols
586-- using 'layerTransport'. 587-- using 'layerTransport'.
587udpTransport :: SockAddr -> IO (Transport err SockAddr ByteString) 588udpTransport :: Show err => SockAddr -> IO (Transport err SockAddr ByteString)
588udpTransport bind_address = fst <$> udpTransport' bind_address 589udpTransport bind_address = fst <$> udpTransport' bind_address
589 590
590-- | Like 'udpTransport' except also returns the raw socket (for broadcast use). 591-- | Like 'udpTransport' except also returns the raw socket (for broadcast use).
591udpTransport' :: SockAddr -> IO (Transport err SockAddr ByteString, Socket) 592udpTransport' :: Show err => SockAddr -> IO (Transport err SockAddr ByteString, Socket)
592udpTransport' bind_address = do 593udpTransport' bind_address = do
593 let family = sockAddrFamily bind_address 594 let family = sockAddrFamily bind_address
594 sock <- socket family Datagram defaultProtocol 595 sock <- socket family Datagram defaultProtocol
@@ -601,6 +602,7 @@ udpTransport' bind_address = do
601 awaitMessage = \kont -> do 602 awaitMessage = \kont -> do
602 r <- handle (ignoreEOF sock isClosed $ Right (B.empty, SockAddrInet 0 0)) $ do 603 r <- handle (ignoreEOF sock isClosed $ Right (B.empty, SockAddrInet 0 0)) $ do
603 Just . Right <$!> B.recvFrom sock udpBufferSize 604 Just . Right <$!> B.recvFrom sock udpBufferSize
605 dput XMisc $ "udp.awaitMessage.recvFrom: " ++ show r
604 kont $! r 606 kont $! r
605 , sendMessage = case family of 607 , sendMessage = case family of
606 AF_INET6 -> \case 608 AF_INET6 -> \case
@@ -618,8 +620,8 @@ udpTransport' bind_address = do
618 addr4 -> \bs -> saferSendTo sock bs addr4 620 addr4 -> \bs -> saferSendTo sock bs addr4
619 _ -> \addr bs -> saferSendTo sock bs addr 621 _ -> \addr bs -> saferSendTo sock bs addr
620 , closeTransport = do 622 , closeTransport = do
621 -- close sock 623 dput XMisc $ "closeTransport for udpTransport' called. " ++ show bind_address
622 tryTakeMVar isClosed >> putMVar isClosed () 624 tryPutMVar isClosed ()
623 -- set O_NONBLOCK using fcntl 625 -- set O_NONBLOCK using fcntl
624 -- NOTE: setNonBlockIfNeeded is a no-op on windows 626 -- NOTE: setNonBlockIfNeeded is a no-op on windows
625#if MIN_VERSION_network (3,1,0) 627#if MIN_VERSION_network (3,1,0)
@@ -627,6 +629,7 @@ udpTransport' bind_address = do
627#else 629#else
628 setNonBlockIfNeeded (fdSocket sock) -- setSocketOption sock ??? 0 630 setNonBlockIfNeeded (fdSocket sock) -- setSocketOption sock ??? 0
629#endif 631#endif
632 -- shutdown sock ShutdownBoth `catchIOError` \_ -> return ()
630 } 633 }
631 return (tr, sock) 634 return (tr, sock)
632 635