UDP Tracker: connect + announce. Does not work

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

diff --git a/src/FuncTorrent/Tracker.hs b/src/FuncTorrent/Tracker.hs
index 815d081d0fc93a6ef011327bb4c5e1411a731bcb..5e059f75c0dda0fb4896ec3941a95869e3013d9f 100644 (file)
--- a/src/FuncTorrent/Tracker.hs
+++ b/src/FuncTorrent/Tracker.hs
@@ -29,20 +29,49 @@ 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)
 import qualified FuncTorrent.FileSystem as FS (MsgChannel)
 import FuncTorrent.Peer (Peer)
 
 type MsgChannel = Chan TrackerMsg
 
+data TrackerUrl = TrackerUrl { protocol :: TrackerProtocol
+                             , host :: String
+                             , port :: Port
+                             , path :: String
+                             }
+
 newTracker :: IO MsgChannel
 newTracker = newChan
 
+parseUrl :: String -> TrackerUrl
+parseUrl url = TrackerUrl proto host port path
+  where proto = getTrackerType url
+        host = getHostname url
+        port = getPort url
+        path = getPath url
+
+getTrackerType :: String -> TrackerProtocol
+getTrackerType url | isPrefixOf "http://" url = Http
+                   | isPrefixOf "udp://" url  = Udp
+                   | otherwise                = UnknownProtocol
+
+getHostname :: String -> String
+getHostname url = takeWhile (/= ':') $ drop 2 $ dropWhile (/= '/') url
+
+getPort :: String -> Port
+getPort url = toPort . pack $ takeWhile (/= '/') $ drop 1 $ dropWhile (/= ':') $ drop 2 $ dropWhile (/= '/') url
+
+getPath :: String -> String
+getPath url = dropWhile (/= '/') $ dropWhile (/= ':') $ drop 1 $ dropWhile (/= ':') url
+
 runTracker :: MsgChannel -> FS.MsgChannel -> ByteString -> PortNumber
            -> String -> [String] -> Integer -> IO ()
 runTracker msgChannel fsChan infohash port peerId announceList sz = do
@@ -51,20 +80,18 @@ 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 host port peerId infohash fsChan initialTState
       runStateT (msgHandler msgChannel) initialTState
       return ()
-    _ -> do
+    Udp -> do
+      _ <- forkIO $ UT.trackerLoop host (fromIntegral port) peerId infohash fsChan initialTState
+      return ()
+    _ ->
       error "Tracker Protocol unimplemented"
 
-getTrackerType :: String -> TrackerProtocol
-getTrackerType url | isPrefixOf "http://" url = Http
-                   | isPrefixOf "udp://" url  = Udp
-                   | otherwise                = UnknownProtocol
-
-
 msgHandler :: MsgChannel -> StateT TState IO ()
 msgHandler c = forever $ do
   st <- get