X-Git-Url: https://git.rkrishnan.org/?a=blobdiff_plain;f=src%2FFuncTorrent%2FTracker.hs;h=8090feb99ea868eb328dc1811332b550984e277c;hb=9beb0fb9814b33725f6adfa5adabb3225a54277b;hp=815d081d0fc93a6ef011327bb4c5e1411a731bcb;hpb=f669c4670f61f71b7ba19368324a2a8a70c09723;p=functorrent.git diff --git a/src/FuncTorrent/Tracker.hs b/src/FuncTorrent/Tracker.hs index 815d081..8090feb 100644 --- a/src/FuncTorrent/Tracker.hs +++ b/src/FuncTorrent/Tracker.hs @@ -29,14 +29,16 @@ import Control.Concurrent.Chan (Chan, newChan, readChan, writeChan) import Control.Concurrent.MVar (newEmptyMVar, putMVar, readMVar) import Control.Monad.State (StateT, liftIO, get, runStateT) import Control.Monad (forever) -import Data.ByteString.Char8 (ByteString) +import Data.ByteString.Char8 (ByteString, pack, unpack) import Data.List (isPrefixOf) import Network (PortNumber) -import FuncTorrent.Tracker.Http (trackerLoop) +import qualified FuncTorrent.Tracker.Http as HT (trackerLoop) +import qualified FuncTorrent.Tracker.Udp as UT (trackerLoop) import FuncTorrent.Tracker.Types (TState(..), TrackerEventState(..), TrackerProtocol(..), TrackerMsg(..)) +import FuncTorrent.Utils (Port, toPort, getHostname) import qualified FuncTorrent.FileSystem as FS (MsgChannel) -import FuncTorrent.Peer (Peer) +import FuncTorrent.PeerMsgs (Peer) type MsgChannel = Chan TrackerMsg @@ -51,18 +53,23 @@ runTracker msgChannel fsChan infohash port peerId announceList sz = do , connectedPeers = ps , left = sz } turl = head announceList + host = getHostname turl case getTrackerType turl of Http -> do - _ <- forkIO $ trackerLoop turl port peerId infohash fsChan initialTState + _ <- forkIO $ HT.trackerLoop turl port peerId infohash fsChan initialTState runStateT (msgHandler msgChannel) initialTState return () - _ -> do + Udp -> do + _ <- forkIO $ UT.trackerLoop turl (fromIntegral port) peerId infohash fsChan initialTState + runStateT (msgHandler msgChannel) initialTState + return () + _ -> error "Tracker Protocol unimplemented" getTrackerType :: String -> TrackerProtocol -getTrackerType url | isPrefixOf "http://" url = Http - | isPrefixOf "udp://" url = Udp - | otherwise = UnknownProtocol +getTrackerType url | "http://" `isPrefixOf` url = Http + | "udp://" `isPrefixOf` url = Udp + | otherwise = UnknownProtocol msgHandler :: MsgChannel -> StateT TState IO () @@ -75,14 +82,13 @@ msgHandler c = forever $ do recvMsg = readChan c sendResponse msg peers = case msg of - GetConnectedPeersMsg var -> do + GetConnectedPeersMsg var -> putMVar var peers - _ -> do + _ -> putStrLn "Unhandled Tracker Msg" getConnectedPeers :: MsgChannel -> IO [Peer] getConnectedPeers c = do v <- newEmptyMVar writeChan c (GetConnectedPeersMsg v) - ps <- readMVar v - return ps + readMVar v