Misc fixes to http tracker.

diff --git a/src/FuncTorrent/Network.hs b/src/FuncTorrent/Network.hs
index 8998bae98b46a26ed40e722355e52c664859244e..ca4b6d9f8fe6bd02aba6db0b88df38743304e6de 100644 (file)
--- a/src/FuncTorrent/Network.hs
+++ b/src/FuncTorrent/Network.hs
@@ -38,7 +38,8 @@ mkParams params = BC.intercalate "&" [concat [pack f, "=", s] | (f,s) <- params]
 
 sendGetRequest :: String -> [(String, ByteString)] -> IO ByteString
 sendGetRequest url args = simpleHTTP (defaultGETRequest_ url') >>= getResponseBody
 
 sendGetRequest :: String -> [(String, ByteString)] -> IO ByteString
 sendGetRequest url args = simpleHTTP (defaultGETRequest_ url') >>= getResponseBody

-    where url' = case parseURI $ unpack $ concat [pack url, "?", qstr] of
+    where url' = case parseURI url'' of

                    Just x -> x
                    Just x -> x

-                   _ -> error "Bad tracker URL"
+                   _ -> error $ "Bad tracker URL: " ++ (show url'')

           qstr = mkParams args
           qstr = mkParams args

+          url'' = unpack $ concat [pack url, "?", qstr]

diff --git a/src/FuncTorrent/Tracker.hs b/src/FuncTorrent/Tracker.hs
index 39ed2982f51bed44181ce73fca3eb7217330c4f9..9873fe1513f073f05efe79b97b2e9bae1522e75e 100644 (file)
--- a/src/FuncTorrent/Tracker.hs
+++ b/src/FuncTorrent/Tracker.hs
@@ -56,7 +56,7 @@ runTracker msgChannel fsChan infohash port peerId announceList sz = do
       host = getHostname turl
   case getTrackerType turl of
     Http -> do
       host = getHostname turl
   case getTrackerType turl of
     Http -> do

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

       runStateT (msgHandler msgChannel) initialTState
       return ()
     Udp -> do
       runStateT (msgHandler msgChannel) initialTState
       return ()
     Udp -> do


@@ -68,7 +68,7 @@ runTracker msgChannel fsChan infohash port peerId announceList sz = do
 getTrackerType :: String -> TrackerProtocol
 getTrackerType url | "http://" `isPrefixOf` url = Http
                    | "udp://" `isPrefixOf` url  = Udp
 getTrackerType :: String -> TrackerProtocol
 getTrackerType url | "http://" `isPrefixOf` url = Http
                    | "udp://" `isPrefixOf` url  = Udp

-                   | otherwise                = UnknownProtocol
+                   | otherwise                  = UnknownProtocol

 
 
 msgHandler :: MsgChannel -> StateT TState IO ()
 
 
 msgHandler :: MsgChannel -> StateT TState IO ()

diff --git a/src/FuncTorrent/Tracker/Http.hs b/src/FuncTorrent/Tracker/Http.hs
index 840b7583d51a39fbdff0a513a264b26145e75b7f..abb4b32963e8812f25071d63f9bf9a4d00821e94 100644 (file)
--- a/src/FuncTorrent/Tracker/Http.hs
+++ b/src/FuncTorrent/Tracker/Http.hs
@@ -27,7 +27,7 @@ import Prelude hiding (lookup, splitAt)
 
 import Control.Concurrent (threadDelay)
 import Control.Concurrent.MVar (readMVar, putMVar, isEmptyMVar, swapMVar)
 
 import Control.Concurrent (threadDelay)
 import Control.Concurrent.MVar (readMVar, putMVar, isEmptyMVar, swapMVar)

-import Control.Monad (forever)
+import Control.Monad (forever, void)

 import qualified Data.ByteString.Base16 as B16 (encode)
 import Data.ByteString (ByteString)
 import Data.ByteString.Char8 as BC (pack, unpack, splitAt)
 import qualified Data.ByteString.Base16 as B16 (encode)
 import Data.ByteString (ByteString)
 import Data.ByteString.Char8 as BC (pack, unpack, splitAt)


@@ -85,17 +85,15 @@ trackerLoop url port peerId infohash fschan tstate = forever $ do
       return () -- $ pack (show e)
     Right trackerInfo ->
       case parseTrackerResponse trackerInfo of
       return () -- $ pack (show e)
     Right trackerInfo ->
       case parseTrackerResponse trackerInfo of

-        Left e -> return () -- e
+        Left e -> return ()

         Right tresp -> do
         Right tresp -> do

-          _ <- threadDelay $ fromIntegral (interval tresp)

           ps <- isEmptyMVar $ connectedPeers tstate
           if ps
           ps <- isEmptyMVar $ connectedPeers tstate
           if ps

-            then do
-            _ <- putMVar (connectedPeers tstate) (peers tresp)
-            return ()
-            else do
-            _ <- swapMVar (connectedPeers tstate) (peers tresp)
-            return ()
+            then
+            putMVar (connectedPeers tstate) (peers tresp)
+            else
+            void $ swapMVar (connectedPeers tstate) (peers tresp)
+          threadDelay $ fromIntegral (interval tresp)

 
 parseTrackerResponse :: BVal -> Either ByteString TrackerResponse
 parseTrackerResponse resp =
 
 parseTrackerResponse :: BVal -> Either ByteString TrackerResponse
 parseTrackerResponse resp =

diff --git a/src/FuncTorrent/Tracker/Udp.hs b/src/FuncTorrent/Tracker/Udp.hs
index aedc4a76af9a777e3d543099dd6f9d9cc33f8b2c..37979c494e7840ca96a2a4aeb5945eca8edd53d6 100644 (file)
--- a/src/FuncTorrent/Tracker/Udp.hs
+++ b/src/FuncTorrent/Tracker/Udp.hs
@@ -223,8 +223,7 @@ trackerLoop url sport peerId infohash fschan tstate = do
   flip runReaderT handle $ do
     t1 <- connectRequest
     cid <- connectResponse t1
   flip runReaderT handle $ do
     t1 <- connectRequest
     cid <- connectResponse t1

-    liftIO $ print "connected: connect id"

     t2 <- announceRequest cid infohash peerId (fromIntegral up) (fromIntegral down) (fromIntegral (left tstate)) (fromIntegral sport)
     t2 <- announceRequest cid infohash peerId (fromIntegral up) (fromIntegral down) (fromIntegral (left tstate)) (fromIntegral sport)

-    liftIO $ print "waiting for announce response"

     stats <- announceResponse t2
     liftIO $ print stats
     stats <- announceResponse t2
     liftIO $ print stats

+--    _ <- threadDelay $