diff options
Diffstat (limited to 'bittorrent/src/Network/BitTorrent/Exchange/Manager.hs')
-rw-r--r-- | bittorrent/src/Network/BitTorrent/Exchange/Manager.hs | 62 |
1 files changed, 62 insertions, 0 deletions
diff --git a/bittorrent/src/Network/BitTorrent/Exchange/Manager.hs b/bittorrent/src/Network/BitTorrent/Exchange/Manager.hs new file mode 100644 index 00000000..30a6a607 --- /dev/null +++ b/bittorrent/src/Network/BitTorrent/Exchange/Manager.hs | |||
@@ -0,0 +1,62 @@ | |||
1 | module Network.BitTorrent.Exchange.Manager | ||
2 | ( Options (..) | ||
3 | , Manager | ||
4 | , Handler | ||
5 | , newManager | ||
6 | , closeManager | ||
7 | ) where | ||
8 | |||
9 | import Control.Concurrent | ||
10 | import Control.Exception hiding (Handler) | ||
11 | import Control.Monad | ||
12 | import Data.Default | ||
13 | import Network.Socket | ||
14 | |||
15 | import Data.Torrent | ||
16 | import Network.Address | ||
17 | import Network.BitTorrent.Exchange.Connection hiding (Options) | ||
18 | import Network.BitTorrent.Exchange.Session | ||
19 | |||
20 | |||
21 | data Options = Options | ||
22 | { optBacklog :: Int | ||
23 | , optPeerAddr :: PeerAddr IP | ||
24 | } deriving (Show, Eq) | ||
25 | |||
26 | instance Default Options where | ||
27 | def = Options | ||
28 | { optBacklog = maxListenQueue | ||
29 | , optPeerAddr = def | ||
30 | } | ||
31 | |||
32 | data Manager = Manager | ||
33 | { listener :: !ThreadId | ||
34 | } | ||
35 | |||
36 | type Handler = InfoHash -> IO Session | ||
37 | |||
38 | handleNewConn :: Socket -> PeerAddr IP -> Handler -> IO () | ||
39 | handleNewConn sock addr handler = do | ||
40 | conn <- newPendingConnection sock addr | ||
41 | ses <- handler (pendingTopic conn) `onException` closePending conn | ||
42 | establish conn ses | ||
43 | |||
44 | listenIncoming :: Options -> Handler -> IO () | ||
45 | listenIncoming Options {..} handler = do | ||
46 | bracket (socket AF_INET Stream defaultProtocol) close $ \ sock -> do | ||
47 | bind sock (toSockAddr optPeerAddr) | ||
48 | listen sock optBacklog | ||
49 | forever $ do | ||
50 | (conn, sockAddr) <- accept sock | ||
51 | case fromSockAddr sockAddr of | ||
52 | Nothing -> return () | ||
53 | Just addr -> void $ forkIO $ handleNewConn sock addr handler | ||
54 | |||
55 | newManager :: Options -> Handler -> IO Manager | ||
56 | newManager opts handler = do | ||
57 | tid <- forkIO $ listenIncoming opts handler | ||
58 | return (Manager tid) | ||
59 | |||
60 | closeManager :: Manager -> IO () | ||
61 | closeManager Manager {..} = do | ||
62 | killThread listener \ No newline at end of file | ||