From a533e0ed9679e77a3e50eb1786dbe3017a4e9928 Mon Sep 17 00:00:00 2001 From: Ramakrishnan Muthukrishnan <ram@rkrishnan.org> Date: Sat, 18 Jun 2016 13:01:10 +0530 Subject: [PATCH] Misc fixes to http tracker. --- src/FuncTorrent/Network.hs | 5 +++-- src/FuncTorrent/Tracker.hs | 4 ++-- src/FuncTorrent/Tracker/Http.hs | 16 +++++++--------- src/FuncTorrent/Tracker/Udp.hs | 3 +-- 4 files changed, 13 insertions(+), 15 deletions(-) diff --git a/src/FuncTorrent/Network.hs b/src/FuncTorrent/Network.hs index 8998bae..ca4b6d9 100644 --- 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 39ed298..9873fe1 100644 --- 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 840b758..abb4b32 100644 --- 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 aedc4a7..37979c4 100644 --- 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 $ -- 2.45.2