summaryrefslogtreecommitdiff
path: root/dht/src/Network
diff options
context:
space:
mode:
Diffstat (limited to 'dht/src/Network')
-rw-r--r--dht/src/Network/QueryResponse.hs17
1 files changed, 8 insertions, 9 deletions
diff --git a/dht/src/Network/QueryResponse.hs b/dht/src/Network/QueryResponse.hs
index 8f3c078d..4f956936 100644
--- a/dht/src/Network/QueryResponse.hs
+++ b/dht/src/Network/QueryResponse.hs
@@ -32,6 +32,7 @@ import qualified Data.Word64Map as W64Map
32 ;import Data.Word64Map (Word64Map) 32 ;import Data.Word64Map (Word64Map)
33import Data.Word 33import Data.Word
34import Data.Maybe 34import Data.Maybe
35import GHC.Conc (closeFdWith)
35import GHC.Event 36import GHC.Event
36import Network.Socket 37import Network.Socket
37import Network.Socket.ByteString as B 38import Network.Socket.ByteString as B
@@ -602,7 +603,6 @@ udpTransport' bind_address = do
602 awaitMessage = \kont -> do 603 awaitMessage = \kont -> do
603 r <- handle (ignoreEOF sock isClosed $ Right (B.empty, SockAddrInet 0 0)) $ do 604 r <- handle (ignoreEOF sock isClosed $ Right (B.empty, SockAddrInet 0 0)) $ do
604 Just . Right <$!> B.recvFrom sock udpBufferSize 605 Just . Right <$!> B.recvFrom sock udpBufferSize
605 dput XMisc $ "udp.awaitMessage.recvFrom: " ++ show r
606 kont $! r 606 kont $! r
607 , sendMessage = case family of 607 , sendMessage = case family of
608 AF_INET6 -> \case 608 AF_INET6 -> \case
@@ -621,15 +621,14 @@ udpTransport' bind_address = do
621 _ -> \addr bs -> saferSendTo sock bs addr 621 _ -> \addr bs -> saferSendTo sock bs addr
622 , closeTransport = do 622 , closeTransport = do
623 dput XMisc $ "closeTransport for udpTransport' called. " ++ show bind_address 623 dput XMisc $ "closeTransport for udpTransport' called. " ++ show bind_address
624 tryPutMVar isClosed () 624 tryPutMVar isClosed () -- signal awaitMessage that the transport is closed.
625 -- set O_NONBLOCK using fcntl 625#if !MIN_VERSION_network (3,1,0)
626 -- NOTE: setNonBlockIfNeeded is a no-op on windows 626 let withFdSocket sock f = f (fdSocket sock)
627#if MIN_VERSION_network (3,1,0)
628 withFdSocket sock $ \fd -> setNonBlockIfNeeded fd
629#else
630 setNonBlockIfNeeded (fdSocket sock) -- setSocketOption sock ??? 0
631#endif 627#endif
632 -- shutdown sock ShutdownBoth `catchIOError` \_ -> return () 628 withFdSocket sock $ \fd -> do
629 let sorryGHCButIAmNotFuckingClosingTheSocketYet fd = return ()
630 -- This call is necessary to interrupt the blocking recvFrom call in awaitMessage.
631 closeFdWith sorryGHCButIAmNotFuckingClosingTheSocketYet (fromIntegral fd)
633 } 632 }
634 return (tr, sock) 633 return (tr, sock)
635 634