diff options
-rw-r--r-- | src/Network/BitTorrent/Client.hs | 6 | ||||
-rw-r--r-- | src/Network/BitTorrent/Exchange/Manager.hs | 22 |
2 files changed, 19 insertions, 9 deletions
diff --git a/src/Network/BitTorrent/Client.hs b/src/Network/BitTorrent/Client.hs index bd4993ba..fce8cfe2 100644 --- a/src/Network/BitTorrent/Client.hs +++ b/src/Network/BitTorrent/Client.hs | |||
@@ -84,7 +84,11 @@ exchangeOptions pid Options {..} = Exchange.Options | |||
84 | } | 84 | } |
85 | 85 | ||
86 | connHandler :: MVar (HashMap InfoHash Handle) -> Exchange.Handler | 86 | connHandler :: MVar (HashMap InfoHash Handle) -> Exchange.Handler |
87 | connHandler _tmap = undefined | 87 | connHandler tmap ih = do |
88 | m <- readMVar tmap | ||
89 | case HM.lookup ih m of | ||
90 | Nothing -> error "torrent not found" | ||
91 | Just (Handle {..}) -> return exchange | ||
88 | 92 | ||
89 | initClient :: Options -> LogFun -> ResIO Client | 93 | initClient :: Options -> LogFun -> ResIO Client |
90 | initClient opts @ Options {..} logFun = do | 94 | initClient opts @ Options {..} logFun = do |
diff --git a/src/Network/BitTorrent/Exchange/Manager.hs b/src/Network/BitTorrent/Exchange/Manager.hs index 1ea9989f..52a51a8d 100644 --- a/src/Network/BitTorrent/Exchange/Manager.hs +++ b/src/Network/BitTorrent/Exchange/Manager.hs | |||
@@ -12,8 +12,10 @@ import Control.Monad | |||
12 | import Data.Default | 12 | import Data.Default |
13 | import Network.Socket | 13 | import Network.Socket |
14 | 14 | ||
15 | import Data.Torrent.InfoHash | ||
15 | import Network.BitTorrent.Core | 16 | import Network.BitTorrent.Core |
16 | 17 | import Network.BitTorrent.Exchange.Session | |
18 | import Network.BitTorrent.Exchange.Wire hiding (Options) | ||
17 | 19 | ||
18 | data Options = Options | 20 | data Options = Options |
19 | { optBacklog :: Int | 21 | { optBacklog :: Int |
@@ -30,7 +32,13 @@ data Manager = Manager | |||
30 | { listener :: !ThreadId | 32 | { listener :: !ThreadId |
31 | } | 33 | } |
32 | 34 | ||
33 | type Handler = Socket -> PeerAddr IP -> IO () | 35 | type Handler = InfoHash -> IO Session |
36 | |||
37 | handleNewConn :: Socket -> PeerAddr IP -> Handler -> IO () | ||
38 | handleNewConn sock addr handler = do | ||
39 | conn <- newPendingConnection sock addr | ||
40 | ses <- handler (pendingTopic conn) `onException` closePending conn | ||
41 | attach conn ses | ||
34 | 42 | ||
35 | listenIncoming :: Options -> Handler -> IO () | 43 | listenIncoming :: Options -> Handler -> IO () |
36 | listenIncoming Options {..} handler = do | 44 | listenIncoming Options {..} handler = do |
@@ -38,12 +46,10 @@ listenIncoming Options {..} handler = do | |||
38 | bind sock (toSockAddr optPeerAddr) | 46 | bind sock (toSockAddr optPeerAddr) |
39 | listen sock optBacklog | 47 | listen sock optBacklog |
40 | forever $ do | 48 | forever $ do |
41 | (conn, addr) <- accept sock | 49 | (conn, sockAddr) <- accept sock |
42 | case fromSockAddr addr of | 50 | case fromSockAddr sockAddr of |
43 | Nothing -> return () | 51 | Nothing -> return () |
44 | Just paddr -> do | 52 | Just addr -> void $ forkIO $ handleNewConn sock addr handler |
45 | forkIO $ handler conn paddr | ||
46 | return () | ||
47 | 53 | ||
48 | newManager :: Options -> Handler -> IO Manager | 54 | newManager :: Options -> Handler -> IO Manager |
49 | newManager opts handler = do | 55 | newManager opts handler = do |