From 56904b7b9799590e5dc4899246157961ae02c543 Mon Sep 17 00:00:00 2001 From: Jaseem Abid Date: Fri, 10 Apr 2015 07:36:35 +0530 Subject: [PATCH] Move things around - `infoHash` is part of metainfo, not tracker alone. Peers need this for handshake - Rename PeerResp to TrackerResponse and move to Tracker.hs - Remove unwanted overhead like `type Port = Integer` - Some more docs, haddock is showing them nicely - Update tests --- src/FuncTorrent.hs | 4 +-- src/FuncTorrent/Metainfo.hs | 14 ++++++-- src/FuncTorrent/Peer.hs | 66 +++++++------------------------------ src/FuncTorrent/Tracker.hs | 64 +++++++++++++++++++++++++++++------ src/Main.hs | 6 ++-- test/Test.hs | 11 ++++--- 6 files changed, 88 insertions(+), 77 deletions(-) diff --git a/src/FuncTorrent.hs b/src/FuncTorrent.hs index 2841c13..b942f5e 100644 --- a/src/FuncTorrent.hs +++ b/src/FuncTorrent.hs @@ -4,7 +4,7 @@ module FuncTorrent InfoDict, Metainfo, Peer, - PeerResp(..), + TrackerResponse(..), announceList, connect, decode, @@ -18,7 +18,7 @@ module FuncTorrent logStop, mkInfo, mkMetaInfo, - mkPeerResp, + mkTrackerResponse, name, prepareRequest, urlEncodeHash diff --git a/src/FuncTorrent/Metainfo.hs b/src/FuncTorrent/Metainfo.hs index 4a95a70..61699a3 100644 --- a/src/FuncTorrent/Metainfo.hs +++ b/src/FuncTorrent/Metainfo.hs @@ -1,16 +1,18 @@ module FuncTorrent.Metainfo (Info(..), Metainfo(..), - mkMetaInfo, - mkInfo + infoHash, + mkInfo, + mkMetaInfo ) where import Prelude hiding (lookup) import Data.ByteString.Char8 (ByteString, unpack) import Data.Map as M ((!), lookup) +import Crypto.Hash.SHA1 (hash) import Data.Maybe (maybeToList) -import FuncTorrent.Bencode (BVal(..), bstrToString) +import FuncTorrent.Bencode (BVal(..), InfoDict, encode, bstrToString) -- only single file mode supported for the time being. data Info = Info { pieceLength :: !Integer @@ -79,3 +81,9 @@ 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 d3c9b11..96c66b0 100644 --- a/src/FuncTorrent/Peer.hs +++ b/src/FuncTorrent/Peer.hs @@ -1,69 +1,27 @@ {-# LANGUAGE OverloadedStrings #-} module FuncTorrent.Peer (Peer(..), - PeerResp(..), - mkPeerResp, handShakeMsg ) where import Prelude hiding (lookup, concat, replicate, splitAt) -import Data.ByteString.Char8 (ByteString, pack, unpack, concat, replicate, splitAt) + +import Data.ByteString.Char8 (ByteString, pack, concat, replicate) import Data.ByteString.Lazy (toChunks) import Data.Int (Int8) -import Data.List (intercalate) -import Data.Map as M ((!), lookup) import qualified Data.Binary as Bin (encode) -import qualified Data.ByteString.Base16 as B16 (encode) - -import FuncTorrent.Bencode (BVal(..), InfoDict) -import FuncTorrent.Tracker (infoHash) -import FuncTorrent.Utils (splitN) +import FuncTorrent.Bencode (InfoDict) +import FuncTorrent.Metainfo (infoHash) -type Address = String -type Port = Integer - -data Peer = Peer Address Port +-- | Peer is a IP address, port tuple +data Peer = Peer String Integer deriving (Show, Eq) -data PeerResp = PeerResp { interval :: Maybe Integer - , peers :: [Peer] - , complete :: Maybe Integer - , incomplete :: Maybe Integer - } deriving (Show, Eq) - -toInt :: String -> Integer -toInt = read - -mkPeerResp :: BVal -> Either ByteString PeerResp -mkPeerResp resp = - case lookup "failure reason" body of - Just (Bstr err) -> Left err - Just _ -> Left "Unknown failure" - Nothing -> - let (Just (Bint i)) = lookup "interval" body - (Bstr peersBS) = body ! "peers" - pl = map (\peer -> let (ip', port') = splitAt 4 peer - in Peer (toIPNum ip') (toPortNum port')) - (splitN 6 peersBS) - in Right PeerResp { - interval = Just i - , peers = pl - , complete = Nothing - , incomplete = Nothing - } - where - (Bdict body) = resp - toPortNum = read . ("0x" ++) . unpack . B16.encode - toIPNum = intercalate "." . - map (show . toInt . ("0x" ++) . unpack) . - splitN 2 . B16.encode - - handShakeMsg :: InfoDict -> String -> ByteString -handShakeMsg m peer_id = let pstrlen = concat $ toChunks $ Bin.encode (19 :: Int8) - pstr = pack "BitTorrent protocol" - reserved = replicate 8 '\0' - infoH = infoHash m - peerID = pack peer_id - in concat [pstrlen, pstr, reserved, infoH, peerID] +handShakeMsg m peer_id = concat [pstrlen, pstr, reserved, infoH, peerID] + where pstrlen = concat $ toChunks $ Bin.encode (19 :: Int8) + pstr = pack "BitTorrent protocol" + reserved = replicate 8 '\0' + infoH = infoHash m + peerID = pack peer_id diff --git a/src/FuncTorrent/Tracker.hs b/src/FuncTorrent/Tracker.hs index 3644781..8d2b3ec 100644 --- a/src/FuncTorrent/Tracker.hs +++ b/src/FuncTorrent/Tracker.hs @@ -1,27 +1,74 @@ +{-# LANGUAGE OverloadedStrings #-} module FuncTorrent.Tracker - (connect, - infoHash, + (TrackerResponse(..), + connect, + mkTrackerResponse, prepareRequest, urlEncodeHash ) where -import Prelude hiding (lookup) -import Crypto.Hash.SHA1 (hash) -import Data.ByteString.Char8 (ByteString, unpack) +import Prelude hiding (lookup, concat, replicate, splitAt) +import Data.ByteString.Char8 (ByteString, unpack, splitAt) import Data.Char (chr) import Data.List (intercalate) +import Data.Map as M (lookup) import Data.Maybe (fromJust) -import Data.Map ((!)) 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 (InfoDict, encode) +import FuncTorrent.Bencode (BVal(..), InfoDict) +import FuncTorrent.Metainfo (infoHash) +import FuncTorrent.Peer (Peer(..)) import FuncTorrent.Utils (splitN) + +-- | Tracker response +data TrackerResponse = TrackerResponse { + interval :: Maybe Integer + , peers :: [Peer] + , complete :: Maybe Integer + , incomplete :: Maybe Integer + } deriving (Show, Eq) + type Url = String +-- | Deserialize tracker response +mkTrackerResponse :: BVal -> Either ByteString TrackerResponse +mkTrackerResponse resp = + case lookup "failure reason" body of + Just (Bstr err) -> Left err + Just _ -> Left "Unknown failure" + Nothing -> + let (Just (Bint i)) = lookup "interval" body + (Just (Bstr peersBS)) = lookup "peers" body + pl = map makePeer (splitN 6 peersBS) + in Right TrackerResponse { + interval = Just i + , peers = pl + , complete = Nothing + , incomplete = Nothing + } + where + (Bdict body) = resp + + toInt :: String -> Integer + toInt = read + + toPort :: ByteString -> Integer + toPort = read . ("0x" ++) . unpack . B16.encode + + toIP :: ByteString -> String + toIP = intercalate "." . + map (show . toInt . ("0x" ++) . unpack) . + splitN 2 . B16.encode + + makePeer :: ByteString -> Peer + makePeer peer = Peer (toIP ip') (toPort port') + where (ip', port') = splitAt 4 peer + + -- | urlEncodeHash -- -- >>> urlEncodeHash $ pack "123456789abcdef123456789abcdef123456789a" @@ -36,9 +83,6 @@ urlEncodeHash bs = concatMap (encode' . unpack) (splitN 2 bs) nonSpecialChars = ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "-_.~" -infoHash :: InfoDict -> ByteString -infoHash m = hash . encode $ (m ! "info") - prepareRequest :: InfoDict -> String -> Integer -> String prepareRequest d peer_id len = let p = [("info_hash", urlEncodeHash ((B16.encode . infoHash) d)), diff --git a/src/Main.hs b/src/Main.hs index b7888e0..3537e48 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -11,8 +11,8 @@ import Text.ParserCombinators.Parsec (ParseError) import FuncTorrent.Bencode (decode, BVal(..)) import FuncTorrent.Logger (initLogger, logMessage, logStop) import FuncTorrent.Metainfo (Info(..), Metainfo(..), mkMetaInfo) -import FuncTorrent.Peer (peers, mkPeerResp, handShakeMsg) -import FuncTorrent.Tracker (connect, prepareRequest) +import FuncTorrent.Peer (handShakeMsg) +import FuncTorrent.Tracker (connect, prepareRequest, peers, mkTrackerResponse) logError :: ParseError -> (String -> IO ()) -> IO () logError e logMsg = logMsg $ "parse error: \n" ++ show e @@ -64,7 +64,7 @@ main = do case decode response of Right trackerInfo -> - case mkPeerResp trackerInfo of + case mkTrackerResponse trackerInfo of Right peerResp -> logMsg $ "Peers List : " ++ (show . peers $ peerResp) Left e -> logMsg $ "Error" ++ unpack e diff --git a/test/Test.hs b/test/Test.hs index 07408db..0f93e8a 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -10,7 +10,8 @@ import Test.Tasty.HUnit import FuncTorrent.Bencode (decode, BVal(..)) import FuncTorrent.Metainfo (Info(..), Metainfo(..), mkMetaInfo) -import FuncTorrent.Peer (Peer(..), PeerResp(..), mkPeerResp) +import FuncTorrent.Peer (Peer(..)) +import FuncTorrent.Tracker (TrackerResponse(..), peers, mkTrackerResponse) -- Parsed .torrent file file :: BVal @@ -61,11 +62,11 @@ testResponse1 :: TestTree testResponse1 = testCase "Should parse valid tracker response" $ do str <- readFile "./data/debian-7.8.0-amd64-CD-1.iso.cache" case decode str of - Right bval -> expectation @?= mkPeerResp bval + Right bval -> expectation @?= mkTrackerResponse bval Left _ -> error "Failed parsing test file" where - expectation :: Either a PeerResp - expectation = Right PeerResp { + expectation :: Either a TrackerResponse + expectation = Right TrackerResponse { interval = Just 900, peers = [Peer "85.25.201.101" 51413, Peer "37.59.28.236" 22222, Peer "76.21.149.43" 51866, Peer "31.183.33.205" 43467, Peer "213.210.120.86" 27480, Peer "213.239.216.205" 6914, Peer "91.192.163.152" 11834, Peer "62.210.240.65" 6999, Peer "84.250.103.161" 6949, Peer "88.195.241.192" 51413, Peer "88.165.61.223" 6881, Peer "86.157.234.243" 59583, Peer "213.41.137.242" 51413, Peer "91.10.84.195" 46941, Peer "64.56.249.183" 7023, Peer "202.62.16.71" 59929, Peer "31.43.126.122" 57816, Peer "68.169.133.72" 50222, Peer "223.135.97.177" 58813, Peer "5.166.93.118" 64459, Peer "200.148.109.141" 51413, Peer "109.226.236.160" 44444, Peer "78.58.139.154" 22818, Peer "188.244.47.186" 39643, Peer "203.86.204.111" 52411, Peer "80.110.40.98" 6918, Peer "68.187.142.217" 58352, Peer "71.115.139.180" 63065, Peer "70.169.35.173" 51413, Peer "185.3.135.186" 10889, Peer "88.198.224.202" 51413, Peer "183.157.65.217" 9179, Peer "87.251.189.150" 46680, Peer "87.114.202.174" 12393, Peer "93.58.5.16" 51411, Peer "89.102.9.69" 10044, Peer "94.159.19.222" 15783, Peer "95.28.49.176" 58794, Peer "217.114.58.135" 6881, Peer "79.141.162.38" 35806, Peer "136.169.50.72" 54927, Peer "187.67.188.151" 51413, Peer "79.111.218.50" 53636, Peer "62.75.137.129" 51413, Peer "14.204.20.156" 11600, Peer "79.141.162.34" 24531, Peer "82.144.192.7" 63208, Peer "212.34.231.10" 20684, Peer "95.225.246.221" 51413, Peer "124.41.237.102" 24874], complete = Nothing, @@ -76,7 +77,7 @@ testResponse2 :: TestTree testResponse2 = testCase "Should parse invalid tracker response" $ do str <- readFile "./data/debian-7.8.0-amd64-CD-1.iso.error" case decode str of - Right bval -> expectation @?= mkPeerResp bval + Right bval -> expectation @?= mkTrackerResponse bval Left _ -> error "Failed parsing test file" where expectation :: Either ByteString a -- 2.37.2