From: Jaseem Abid Date: Sat, 11 Apr 2015 11:19:26 +0000 (+0530) Subject: Clean up tracker network code X-Git-Url: https://git.rkrishnan.org/pf/content/en/seg/priv/class-simplejson.JSONDecoder-index.html?a=commitdiff_plain;h=677f43e145aa2bb62f580be8b2fd72eccf212c1f;p=functorrent.git Clean up tracker network code - Made info_hash an attribute of meta info - Refactored a `get` function - Removed few more useless types - Cleaned up log messages - Remove unnecessary Url type - Fix double urlEncode TIL You should ideally always write total functions in Haskell. --- diff --git a/src/FuncTorrent.hs b/src/FuncTorrent.hs index b942f5e..67fc309 100644 --- a/src/FuncTorrent.hs +++ b/src/FuncTorrent.hs @@ -1,27 +1,19 @@ module FuncTorrent (BVal(..), - Info, - InfoDict, - Metainfo, + Info(..), + Metainfo(..), Peer, TrackerResponse(..), - announceList, connect, decode, encode, handShakeMsg, - info, - infoHash, initLogger, - lengthInBytes, logMessage, logStop, mkInfo, mkMetaInfo, - mkTrackerResponse, - name, - prepareRequest, - urlEncodeHash + mkTrackerResponse ) where import FuncTorrent.Bencode diff --git a/src/FuncTorrent/Bencode.hs b/src/FuncTorrent/Bencode.hs index bbeca65..2b641a7 100644 --- a/src/FuncTorrent/Bencode.hs +++ b/src/FuncTorrent/Bencode.hs @@ -1,14 +1,13 @@ {-# LANGUAGE OverloadedStrings #-} -module FuncTorrent.Bencode ( - BVal(..) - , InfoDict - , bstrToString - , bValToInteger - , bValToInfoDict +module FuncTorrent.Bencode + (BVal(..) , bValToBList , bValToBstr - , encode + , bValToInfoDict + , bValToInteger + , bstrToString , decode + , encode ) where import Prelude hiding (length, concat) @@ -24,7 +23,7 @@ import qualified Text.Parsec.ByteString as ParsecBS data BVal = Bint Integer | Bstr ByteString | Blist [BVal] - | Bdict InfoDict + | Bdict (Map String BVal) deriving (Ord, Eq, Show) -- getters @@ -40,15 +39,13 @@ bValToBList :: BVal -> Maybe [BVal] bValToBList (Blist lst) = Just lst bValToBList _ = Nothing -bValToInfoDict :: BVal -> Maybe InfoDict +bValToInfoDict :: BVal -> Maybe (Map String BVal) bValToInfoDict (Bdict dict) = Just dict bValToInfoDict _ = Nothing bstrToString :: BVal -> Maybe String bstrToString bval = unpack <$> bValToBstr bval -type InfoDict = Map String BVal - -- $setup -- >>> import Data.Either @@ -122,7 +119,7 @@ bencList = do _ <- spaces -- Right (fromList [("spam",Blist [Bstr "a",Bstr "b"])]) -- >>> parse bencDict "Bdict" (pack "d9:publisher3:bob17:publisher-webpage15:www.example.com18:publisher.location4:homee") -- Right (fromList [("publisher",Bstr "bob"),("publisher-webpage",Bstr "www.example.com"),("publisher.location",Bstr "home")]) -bencDict :: ParsecBS.Parser InfoDict +bencDict :: ParsecBS.Parser (Map String BVal) bencDict = between (char 'd') (char 'e') $ fromList <$> many kvpair where kvpair = do k <- bencStr v <- bencVal diff --git a/src/FuncTorrent/Logger.hs b/src/FuncTorrent/Logger.hs index 255809b..81bc9f4 100644 --- a/src/FuncTorrent/Logger.hs +++ b/src/FuncTorrent/Logger.hs @@ -16,7 +16,6 @@ import Control.Concurrent -- -- The MVar in stop is just to ensure the logger thread executes completely -- Before exiting the main application. --- data Logger = Logger (MVar LogCommand) data LogCommand = Message String | Stop (MVar ()) diff --git a/src/FuncTorrent/Metainfo.hs b/src/FuncTorrent/Metainfo.hs index 1695b59..a3313d1 100644 --- a/src/FuncTorrent/Metainfo.hs +++ b/src/FuncTorrent/Metainfo.hs @@ -1,7 +1,6 @@ module FuncTorrent.Metainfo (Info(..), Metainfo(..), - infoHash, mkInfo, mkMetaInfo ) where @@ -12,7 +11,7 @@ import Data.Map as M ((!), lookup) import Crypto.Hash.SHA1 (hash) import Data.Maybe (maybeToList) -import FuncTorrent.Bencode (BVal(..), InfoDict, encode, bstrToString, bValToInteger) +import FuncTorrent.Bencode (BVal(..), encode, bstrToString, bValToInteger) -- only single file mode supported for the time being. data Info = Info { pieceLength :: !Integer @@ -29,6 +28,7 @@ data Metainfo = Metainfo { info :: !Info , comment :: !(Maybe String) , createdBy :: !(Maybe String) , encoding :: !(Maybe String) + , infoHash :: !ByteString } deriving (Eq, Show) mkInfo :: BVal -> Maybe Info @@ -63,7 +63,9 @@ mkMetaInfo (Bdict m) = , comment = bstrToString =<< comment' , createdBy = bstrToString =<< createdBy' , encoding = bstrToString =<< encoding' + , infoHash = hash . encode $ (m ! "info") } + mkMetaInfo _ = Nothing getAnnounceList :: Maybe BVal -> [String] @@ -78,9 +80,3 @@ getAnnounceList (Just (Blist l)) = map (\s -> case s of _ -> "") l getAnnounceList (Just (Bdict _)) = [] - --- | Info hash is urlencoded 20 byte SHA1 hash of the value of the info key from --- the Metainfo file. Note that the value will be a bencoded dictionary, given --- the definition of the info key above. TODO: `Metainfo -> ByteString` -infoHash :: InfoDict -> ByteString -infoHash m = hash . encode $ (m ! "info") diff --git a/src/FuncTorrent/Peer.hs b/src/FuncTorrent/Peer.hs index 96c66b0..b0c546b 100644 --- a/src/FuncTorrent/Peer.hs +++ b/src/FuncTorrent/Peer.hs @@ -11,14 +11,13 @@ import Data.ByteString.Lazy (toChunks) import Data.Int (Int8) import qualified Data.Binary as Bin (encode) -import FuncTorrent.Bencode (InfoDict) -import FuncTorrent.Metainfo (infoHash) +import FuncTorrent.Metainfo (Metainfo(..)) -- | Peer is a IP address, port tuple data Peer = Peer String Integer deriving (Show, Eq) -handShakeMsg :: InfoDict -> String -> ByteString +handShakeMsg :: Metainfo -> String -> ByteString handShakeMsg m peer_id = concat [pstrlen, pstr, reserved, infoH, peerID] where pstrlen = concat $ toChunks $ Bin.encode (19 :: Int8) pstr = pack "BitTorrent protocol" diff --git a/src/FuncTorrent/Tracker.hs b/src/FuncTorrent/Tracker.hs index 8d2b3ec..749f75d 100644 --- a/src/FuncTorrent/Tracker.hs +++ b/src/FuncTorrent/Tracker.hs @@ -2,26 +2,28 @@ module FuncTorrent.Tracker (TrackerResponse(..), connect, + mkArgs, + mkParams, mkTrackerResponse, - prepareRequest, urlEncodeHash ) where import Prelude hiding (lookup, concat, replicate, splitAt) -import Data.ByteString.Char8 (ByteString, unpack, splitAt) + +import Data.ByteString (ByteString) +import Data.ByteString.Char8 as BC (pack, unpack, splitAt, concat, intercalate) import Data.Char (chr) import Data.List (intercalate) import Data.Map as M (lookup) -import Data.Maybe (fromJust) import Network.HTTP (simpleHTTP, defaultGETRequest_, getResponseBody) import Network.HTTP.Base (urlEncode) import Network.URI (parseURI) import qualified Data.ByteString.Base16 as B16 (encode) -import FuncTorrent.Bencode (BVal(..), InfoDict) -import FuncTorrent.Metainfo (infoHash) +import FuncTorrent.Bencode (BVal(..)) import FuncTorrent.Peer (Peer(..)) import FuncTorrent.Utils (splitN) +import FuncTorrent.Metainfo (Info(..), Metainfo(..)) -- | Tracker response @@ -32,8 +34,6 @@ data TrackerResponse = TrackerResponse { , incomplete :: Maybe Integer } deriving (Show, Eq) -type Url = String - -- | Deserialize tracker response mkTrackerResponse :: BVal -> Either ByteString TrackerResponse mkTrackerResponse resp = @@ -60,7 +60,7 @@ mkTrackerResponse resp = toPort = read . ("0x" ++) . unpack . B16.encode toIP :: ByteString -> String - toIP = intercalate "." . + toIP = Data.List.intercalate "." . map (show . toInt . ("0x" ++) . unpack) . splitN 2 . B16.encode @@ -68,11 +68,14 @@ mkTrackerResponse resp = makePeer peer = Peer (toIP ip') (toPort port') where (ip', port') = splitAt 4 peer +-- | Connect to a tracker and get peer info +connect :: Metainfo -> String -> IO ByteString +connect m peer_id = get (head . announceList $ m) $ mkArgs m peer_id --- | urlEncodeHash --- --- >>> urlEncodeHash $ pack "123456789abcdef123456789abcdef123456789a" --- "%124Vx%9a%bc%de%f1%23Eg%89%ab%cd%ef%124Vx%9a" +--- | URL encode hash as per RFC1738 +--- TODO: Add tests +--- REVIEW: Why is this not written in terms of `Network.HTTP.Base.urlEncode` or +--- equivalent library function? urlEncodeHash :: ByteString -> String urlEncodeHash bs = concatMap (encode' . unpack) (splitN 2 bs) where encode' b@[c1, c2] = let c = chr (read ("0x" ++ b)) @@ -83,18 +86,26 @@ urlEncodeHash bs = concatMap (encode' . unpack) (splitN 2 bs) nonSpecialChars = ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "-_.~" -prepareRequest :: InfoDict -> String -> Integer -> String -prepareRequest d peer_id len = - let p = [("info_hash", urlEncodeHash ((B16.encode . infoHash) d)), - ("peer_id", urlEncode peer_id), - ("port", "6881"), - ("uploaded", "0"), - ("downloaded", "0"), - ("left", show len), - ("compact", "1"), - ("event", "started")] - in intercalate "&" [f ++ "=" ++ s | (f,s) <- p] - -connect :: Url -> String -> IO ByteString -connect baseurl qstr = simpleHTTP (defaultGETRequest_ url) >>= getResponseBody - where url = fromJust . parseURI $ (baseurl ++ "?" ++ qstr) +-- | Make arguments that should be posted to tracker. +-- This is a separate pure function for testability. +mkArgs :: Metainfo -> String -> [(String, ByteString)] +mkArgs m peer_id = [("info_hash", pack . urlEncodeHash . B16.encode . infoHash $ m), + ("peer_id", pack . urlEncode $ peer_id), + ("port", "6881"), + ("uploaded", "0"), + ("downloaded", "0"), + ("left", pack . show . lengthInBytes $ info m), + ("compact", "1"), + ("event", "started")] + +-- | Make a query string from a alist of k, v +-- TODO: Url encode each argument +mkParams :: [(String, ByteString)] -> ByteString +mkParams params = BC.intercalate "&" [concat [pack f, "=", s] | (f,s) <- params] + +get :: String -> [(String, ByteString)] -> IO ByteString +get url args = simpleHTTP (defaultGETRequest_ url') >>= getResponseBody + where url' = case parseURI $ unpack $ concat [pack url, "?", qstr] of + Just x -> x + _ -> error "Bad tracker URL" + qstr = mkParams args diff --git a/src/Main.hs b/src/Main.hs index 3537e48..791b4b5 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -1,18 +1,18 @@ {-# LANGUAGE OverloadedStrings #-} module Main where -import Prelude hiding (length, readFile, writeFile) +import Prelude hiding (log, length, readFile, writeFile) import Data.ByteString.Char8 (ByteString, readFile, writeFile, length, unpack) import System.Environment (getArgs) import System.Exit (exitSuccess) import System.Directory (doesFileExist) import Text.ParserCombinators.Parsec (ParseError) -import FuncTorrent.Bencode (decode, BVal(..)) +import FuncTorrent.Bencode (decode) import FuncTorrent.Logger (initLogger, logMessage, logStop) import FuncTorrent.Metainfo (Info(..), Metainfo(..), mkMetaInfo) import FuncTorrent.Peer (handShakeMsg) -import FuncTorrent.Tracker (connect, prepareRequest, peers, mkTrackerResponse) +import FuncTorrent.Tracker (connect, peers, mkTrackerResponse) logError :: ParseError -> (String -> IO ()) -> IO () logError e logMsg = logMsg $ "parse error: \n" ++ show e @@ -39,25 +39,24 @@ main :: IO () main = do args <- getArgs logR <- initLogger - let logMsg = logMessage logR - logMsg $ "Parsing input file: " ++ concat args + let log = logMessage logR + log "Starting up functorrent" + log $ "Parsing input file " ++ concat args torrentStr <- parse args case decode torrentStr of Right d -> case mkMetaInfo d of - Nothing -> logMsg "parse error" + Nothing -> log "Unable to make meta info file" Just m -> do - logMsg "Input File OK" + log "Input File OK" + log $ "Downloading file : " ++ name (info m) + log "Trying to fetch peers" - let len = lengthInBytes $ info m - (Bdict d') = d - trackers = announceList m + log $ "Trackers: " ++ head (announceList m) + response <- connect m peerId - logMsg "Trying to fetch peers: " - response <- connect (head trackers) (prepareRequest d' peerId len) - - let hsMsgLen = show $ length $ handShakeMsg d' peerId - logMsg $ "Hand-shake message length : " ++ hsMsgLen + let hsMsgLen = show $ length $ handShakeMsg m peerId + log $ "Hand-shake message length : " ++ hsMsgLen -- TODO: Write to ~/.functorrent/caches writeFile (name (info m) ++ ".cache") response @@ -66,9 +65,9 @@ main = do Right trackerInfo -> case mkTrackerResponse trackerInfo of Right peerResp -> - logMsg $ "Peers List : " ++ (show . peers $ peerResp) - Left e -> logMsg $ "Error" ++ unpack e - Left e -> logError e logMsg + log $ "Peers List : " ++ (show . peers $ peerResp) + Left e -> log $ "Error" ++ unpack e + Left e -> logError e log - Left e -> logError e logMsg + Left e -> logError e log logStop logR diff --git a/test/Test.hs b/test/Test.hs index 3ead970..fb6c768 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -2,7 +2,8 @@ module Main where import Prelude hiding (readFile) -import Data.ByteString.Char8 (ByteString, readFile) + +import Data.ByteString (ByteString, readFile) import Data.Map.Strict (fromList) import Test.Tasty @@ -11,7 +12,7 @@ import Test.Tasty.HUnit import FuncTorrent.Bencode (decode, BVal(..)) import FuncTorrent.Metainfo (Info(..), Metainfo(..), mkMetaInfo) import FuncTorrent.Peer (Peer(..)) -import FuncTorrent.Tracker (TrackerResponse(..), peers, mkTrackerResponse) +import FuncTorrent.Tracker -- Parsed .torrent file file :: BVal @@ -38,6 +39,7 @@ hello = Metainfo { lengthInBytes = 12, md5sum = Nothing }, + infoHash = "\249\SYN\145=\129\182\205\\\181v0\144\154\EM\150f\152\221]}", announceList = ["http://9.rarbg.com:2710/announce"], creationDate = Just 1428717851, comment = Just "hello world",