X-Git-Url: https://git.rkrishnan.org/?a=blobdiff_plain;f=src%2FFuncTorrent%2FTracker.hs;h=8090feb99ea868eb328dc1811332b550984e277c;hb=9beb0fb9814b33725f6adfa5adabb3225a54277b;hp=157880842cc23951f909dda0e7a489d57bdd1c5f;hpb=5b18521efb136dfa7d0676f195a2cdf38744d660;p=functorrent.git diff --git a/src/FuncTorrent/Tracker.hs b/src/FuncTorrent/Tracker.hs index 1578808..8090feb 100644 --- a/src/FuncTorrent/Tracker.hs +++ b/src/FuncTorrent/Tracker.hs @@ -1,3 +1,22 @@ +{- + - Copyright (C) 2015-2016 Ramakrishnan Muthukrishnan + - + - This file is part of FuncTorrent. + - + - FuncTorrent is free software; you can redistribute it and/or modify + - it under the terms of the GNU General Public License as published by + - the Free Software Foundation; either version 3 of the License, or + - (at your option) any later version. + - + - FuncTorrent is distributed in the hope that it will be useful, + - but WITHOUT ANY WARRANTY; without even the implied warranty of + - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + - GNU General Public License for more details. + - + - You should have received a copy of the GNU General Public License + - along with FuncTorrent; if not, see + -} + {-# LANGUAGE OverloadedStrings #-} module FuncTorrent.Tracker (runTracker @@ -10,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 @@ -32,18 +53,23 @@ runTracker msgChannel fsChan infohash port peerId announceList sz = do , connectedPeers = ps , left = sz } turl = head announceList - case (getTrackerType turl) of + 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 () + Udp -> do + _ <- forkIO $ UT.trackerLoop turl (fromIntegral port) peerId infohash fsChan initialTState runStateT (msgHandler msgChannel) initialTState return () - _ -> do + _ -> 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 () @@ -56,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