Misc fixes to http tracker.

[functorrent.git] / src / FuncTorrent / Tracker.hs

diff --git a/src/FuncTorrent/Tracker.hs b/src/FuncTorrent/Tracker.hs
index 157880842cc23951f909dda0e7a489d57bdd1c5f..9873fe1513f073f05efe79b97b2e9bae1522e75e 100644 (file)
--- a/src/FuncTorrent/Tracker.hs
+++ b/src/FuncTorrent/Tracker.hs
@@ -1,3 +1,22 @@
+{-
+ - Copyright (C) 2015-2016 Ramakrishnan Muthukrishnan <ram@rkrishnan.org>
+ -
+ - 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 <http://www.gnu.org/licenses/>
+ -}
+

 {-# LANGUAGE OverloadedStrings #-}
 module FuncTorrent.Tracker
        (runTracker
 {-# LANGUAGE OverloadedStrings #-}
 module FuncTorrent.Tracker
        (runTracker


@@ -10,12 +29,14 @@ 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 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 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.Tracker.Types (TState(..), TrackerEventState(..), TrackerProtocol(..), TrackerMsg(..))

+import FuncTorrent.Utils (Port, toPort, getHostname)

 import qualified FuncTorrent.FileSystem as FS (MsgChannel)
 import FuncTorrent.Peer (Peer)
 
 import qualified FuncTorrent.FileSystem as FS (MsgChannel)
 import FuncTorrent.Peer (Peer)
 


@@ -32,18 +53,22 @@ runTracker msgChannel fsChan infohash port peerId announceList sz = do
                              , connectedPeers = ps
                              , left = sz }
       turl = head announceList
                              , connectedPeers = ps
                              , left = sz }
       turl = head announceList

-  case (getTrackerType turl) of
+      host = getHostname turl
+  case getTrackerType turl of

     Http -> do
     Http -> do

-      _ <- forkIO $ trackerLoop turl port peerId infohash fsChan initialTState
+      _ <- forkIO $ HT.trackerLoop turl port peerId infohash fsChan initialTState

       runStateT (msgHandler msgChannel) initialTState
       return ()
       runStateT (msgHandler msgChannel) initialTState
       return ()

-    _ -> do
+    Udp -> do
+      _ <- forkIO $ UT.trackerLoop turl (fromIntegral port) peerId infohash fsChan initialTState
+      return ()
+    _ ->

       error "Tracker Protocol unimplemented"
 
 getTrackerType :: String -> TrackerProtocol
       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 ()
 
 
 msgHandler :: MsgChannel -> StateT TState IO ()


@@ -56,14 +81,13 @@ msgHandler c = forever $ do
       recvMsg = readChan c
       sendResponse msg peers =
         case msg of
       recvMsg = readChan c
       sendResponse msg peers =
         case msg of

-          GetConnectedPeersMsg var -> do
+          GetConnectedPeersMsg var ->

             putMVar var peers
             putMVar var peers

-          _ -> do
+          _ ->

             putStrLn "Unhandled Tracker Msg"
 
 getConnectedPeers :: MsgChannel -> IO [Peer]
 getConnectedPeers c = do
   v <- newEmptyMVar
   writeChan c (GetConnectedPeersMsg v)
             putStrLn "Unhandled Tracker Msg"
 
 getConnectedPeers :: MsgChannel -> IO [Peer]
 getConnectedPeers c = do
   v <- newEmptyMVar
   writeChan c (GetConnectedPeersMsg v)

-  ps <- readMVar v
-  return ps
+  readMVar v