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
-    where url' = case parseURI $ unpack $ concat [pack url, "?", qstr] of
+    where url' = case parseURI url'' of
                    Just x -> x
-                   _ -> error "Bad tracker URL"
+                   _ -> error $ "Bad tracker URL: " ++ (show url'')
           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
-      _ <- 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
@@ -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
-                   | otherwise                = UnknownProtocol
+                   | otherwise                  = UnknownProtocol
 
 
 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.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)
@@ -85,17 +85,15 @@ trackerLoop url port peerId infohash fschan tstate = forever $ do
       return () -- $ pack (show e)
     Right trackerInfo ->
       case parseTrackerResponse trackerInfo of
-        Left e -> return () -- e
+        Left e -> return ()
         Right tresp -> do
-          _ <- threadDelay $ fromIntegral (interval tresp)
           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 =

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
-    liftIO $ print "connected: connect id"
     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
+--    _ <- threadDelay $