bracket all socket-using operations to avoid resource leakage

This commit is contained in:
Trolli Schmittlauch 2020-05-27 17:48:01 +02:00
parent b1c5c5e5f4
commit 27e5c5f9ce
3 changed files with 47 additions and 44 deletions

View file

@ -23,6 +23,7 @@ module Hash2Pub.DHTProtocol
where
import Control.Concurrent.Async
import Control.Exception
import Control.Concurrent.STM
import Control.Concurrent.STM.TBQueue
import Control.Concurrent.STM.TQueue
@ -146,8 +147,8 @@ markCacheEntryAsVerified timestamp = Map.adjust adjustFunc
requestJoin :: NodeState a => a -- ^ currently responsible node to be contacted
-> LocalNodeState -- ^ joining NodeState
-> IO (Maybe LocalNodeState) -- ^ node after join with all its new information
requestJoin toJoinOn ownState = do
sock <- mkSendSocket (getDomain toJoinOn) (getDhtPort toJoinOn)
requestJoin toJoinOn ownState =
bracket (mkSendSocket (getDomain toJoinOn) (getDhtPort toJoinOn)) close (\sock -> do
responses <- sendRequestTo 5000 3 (\rid -> Request rid (toRemoteNodeState ownState) 1 1 Join (Just JoinRequestPayload)) sock
joinedStateUnsorted <- foldM
(\nsAcc msg -> case payload msg of
@ -168,6 +169,7 @@ requestJoin toJoinOn ownState = do
then pure Nothing
-- sort successors and predecessors
else pure . Just . setSuccessors (sortBy localCompare $ successors joinedStateUnsorted) . setPredecessors (sortBy localCompare $ predecessors joinedStateUnsorted) $ joinedStateUnsorted
)
-- | Send a 'QueryID' 'Request' for getting the node that handles a certain key ID.
@ -192,10 +194,9 @@ queryIdLookupLoop cacheSnapshot ns targetID = do
case localResult of
FOUND thisNode -> pure thisNode
FORWARD nodeSet -> do
-- create connected sockets to all query targets
sockets <- mapM (\resultNode -> mkSendSocket (getDomain resultNode) (getDhtPort resultNode)) $ remoteNode <$> Set.toList nodeSet
-- create connected sockets to all query targets and use them for request handling
-- ToDo: make attempts and timeout configurable
queryThreads <- mapM (async . sendQueryIdMessage targetID ns) sockets
queryThreads <- mapM (\resultNode -> async $ bracket (mkSendSocket (getDomain resultNode) (getDhtPort resultNode)) close (sendQueryIdMessage targetID ns)) $ remoteNode <$> Set.toList nodeSet
-- ToDo: process results immediately instead of waiting for the last one to finish, see https://stackoverflow.com/a/38815224/9198613
-- ToDo: exception handling, maybe log them
responses <- (mconcat . fmap Set.elems) . rights <$> mapM waitCatch queryThreads

View file

@ -117,9 +117,9 @@ fediChordBootstrapJoin :: LocalNodeState -- ^ the local 'NodeState'
-> (String, PortNumber) -- ^ domain and port of a bootstrapping node
-> IO (Either String LocalNodeState) -- ^ the joined 'NodeState' after a
-- successful join, otherwise an error message
fediChordBootstrapJoin ns (joinHost, joinPort) = do
fediChordBootstrapJoin ns (joinHost, joinPort) =
-- can be invoked multiple times with all known bootstrapping nodes until successfully joined
sock <- mkSendSocket joinHost joinPort
bracket (mkSendSocket joinHost joinPort) close (\sock -> do
-- 1. get routed to placement of own ID until FOUND:
-- Initialise an empty cache only with the responses from a bootstrapping node
bootstrapResponse <- sendQueryIdMessage (getNid ns) ns sock
@ -137,6 +137,7 @@ fediChordBootstrapJoin ns (joinHost, joinPort) = do
)
initCache bootstrapResponse
fediChordJoin bootstrapCache ns
)
-- | join a node to the DHT, using the provided cache snapshot for resolving the new
-- node's position.

View file

@ -1,6 +1,7 @@
module Main where
import Control.Concurrent
import Control.Exception
import Data.IP (IPv6, toHostAddress6)
import System.Environment