2 - Copyright (C) 2015-2016 Ramakrishnan Muthukrishnan <ram@rkrishnan.org>
4 - This file is part of FuncTorrent.
6 - FuncTorrent is free software; you can redistribute it and/or modify
7 - it under the terms of the GNU General Public License as published by
8 - the Free Software Foundation; either version 3 of the License, or
9 - (at your option) any later version.
11 - FuncTorrent is distributed in the hope that it will be useful,
12 - but WITHOUT ANY WARRANTY; without even the implied warranty of
13 - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 - GNU General Public License for more details.
16 - You should have received a copy of the GNU General Public License
17 - along with FuncTorrent; if not, see <http://www.gnu.org/licenses/>
20 {-# LANGUAGE OverloadedStrings #-}
21 module FuncTorrent.Tracker
27 import Control.Concurrent(forkIO)
28 import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan)
29 import Control.Concurrent.MVar (newEmptyMVar, putMVar, readMVar)
30 import Control.Monad.State (StateT, liftIO, get, runStateT)
31 import Control.Monad (forever)
32 import Data.ByteString.Char8 (ByteString, pack, unpack)
33 import Data.List (isPrefixOf)
34 import Network (PortNumber)
36 import qualified FuncTorrent.Tracker.Http as HT (trackerLoop)
37 import qualified FuncTorrent.Tracker.Udp as UT (trackerLoop)
38 import FuncTorrent.Tracker.Types (TState(..), TrackerEventState(..), TrackerProtocol(..), TrackerMsg(..))
39 import FuncTorrent.Utils (Port, toPort, getHostname)
40 import qualified FuncTorrent.FileSystem as FS (MsgChannel)
41 import FuncTorrent.Peer (Peer)
43 type MsgChannel = Chan TrackerMsg
45 newTracker :: IO MsgChannel
48 runTracker :: MsgChannel -> FS.MsgChannel -> ByteString -> PortNumber
49 -> String -> [String] -> Integer -> IO ()
50 runTracker msgChannel fsChan infohash port peerId announceList sz = do
52 let initialTState = TState { currentState = None
55 turl = head announceList
56 host = getHostname turl
57 case getTrackerType turl of
59 _ <- forkIO $ HT.trackerLoop turl port peerId infohash fsChan initialTState
60 runStateT (msgHandler msgChannel) initialTState
63 _ <- forkIO $ UT.trackerLoop turl (fromIntegral port) peerId infohash fsChan initialTState
66 error "Tracker Protocol unimplemented"
68 getTrackerType :: String -> TrackerProtocol
69 getTrackerType url | "http://" `isPrefixOf` url = Http
70 | "udp://" `isPrefixOf` url = Udp
71 | otherwise = UnknownProtocol
74 msgHandler :: MsgChannel -> StateT TState IO ()
75 msgHandler c = forever $ do
77 peers <- liftIO $ readMVar (connectedPeers st)
79 liftIO $ sendResponse msg peers
82 sendResponse msg peers =
84 GetConnectedPeersMsg var ->
87 putStrLn "Unhandled Tracker Msg"
89 getConnectedPeers :: MsgChannel -> IO [Peer]
90 getConnectedPeers c = do
92 writeChan c (GetConnectedPeersMsg v)