From 3d076eb8b041e4e556a12a85ba5cf2d1b82ccee6 Mon Sep 17 00:00:00 2001 From: Jaseem Abid Date: Sun, 29 Mar 2015 17:54:58 +0530 Subject: [PATCH] Handle error cases from the tracker Tracker might reply that the requested torrent is unavailable. Sample response at `data/debian-7.8.0-amd64-CD-1.iso.error`. Renamed `getPeerResponse` to `mkPeerResp` and changed it singture to match other `mk*` functions like `mkMetaInfo`. Added test cases New checks made the code one more level deep. Will need a refactor with the Either Monad. --- data/debian-7.8.0-amd64-CD-1.iso.error | 1 + src/FuncTorrent.hs | 2 +- src/FuncTorrent/Peer.hs | 51 +++++++++++++------------- src/Main.hs | 23 +++++++----- test/Test.hs | 44 ++++++++++++++-------- 5 files changed, 70 insertions(+), 51 deletions(-) create mode 100644 data/debian-7.8.0-amd64-CD-1.iso.error diff --git a/data/debian-7.8.0-amd64-CD-1.iso.error b/data/debian-7.8.0-amd64-CD-1.iso.error new file mode 100644 index 0000000..c19b09a --- /dev/null +++ b/data/debian-7.8.0-amd64-CD-1.iso.error @@ -0,0 +1 @@ +d14:failure reason17:torrent not founde \ No newline at end of file diff --git a/src/FuncTorrent.hs b/src/FuncTorrent.hs index c05be76..e5f9b5c 100644 --- a/src/FuncTorrent.hs +++ b/src/FuncTorrent.hs @@ -9,7 +9,6 @@ module FuncTorrent connect, decode, encode, - getPeerResponse, handShakeMsg, info, infoHash, @@ -19,6 +18,7 @@ module FuncTorrent logStop, mkInfo, mkMetaInfo, + mkPeerResp, name, prepareRequest, urlEncodeHash diff --git a/src/FuncTorrent/Peer.hs b/src/FuncTorrent/Peer.hs index f9fdbc3..d3c9b11 100644 --- a/src/FuncTorrent/Peer.hs +++ b/src/FuncTorrent/Peer.hs @@ -1,7 +1,8 @@ +{-# LANGUAGE OverloadedStrings #-} module FuncTorrent.Peer (Peer(..), PeerResp(..), - getPeerResponse, + mkPeerResp, handShakeMsg ) where @@ -14,7 +15,7 @@ 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, decode) +import FuncTorrent.Bencode (BVal(..), InfoDict) import FuncTorrent.Tracker (infoHash) import FuncTorrent.Utils (splitN) @@ -34,29 +35,29 @@ data PeerResp = PeerResp { interval :: Maybe Integer toInt :: String -> Integer toInt = read -getPeerResponse :: ByteString -> PeerResp -getPeerResponse body = case decode body of - Right (Bdict peerM) -> - let (Just (Bint i)) = lookup "interval" peerM - (Bstr peersBS) = peerM ! "peers" - pl = map (\peer -> let (ip', port') = splitAt 4 peer - in Peer (toIPNum ip') (toPortNum port')) - (splitN 6 peersBS) - in PeerResp { interval = Just i - , peers = pl - , complete = Nothing - , incomplete = Nothing - } - where toPortNum = read . ("0x" ++) . unpack . B16.encode - toIPNum = intercalate "." . - map (show . toInt . ("0x" ++) . unpack) . - splitN 2 . B16.encode - - _ -> PeerResp { interval = Nothing - , peers = [] - , complete = Nothing - , incomplete = Nothing - } +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 diff --git a/src/Main.hs b/src/Main.hs index d081265..7757331 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -2,7 +2,7 @@ module Main where import Prelude hiding (length, readFile, writeFile) -import Data.ByteString.Char8 (ByteString, readFile, writeFile, length) +import Data.ByteString.Char8 (ByteString, readFile, writeFile, length, unpack) import System.Environment (getArgs) import System.Exit (exitSuccess) import System.Directory (doesFileExist) @@ -11,7 +11,7 @@ import Text.ParserCombinators.Parsec (ParseError) import FuncTorrent.Bencode (decode, BVal(..)) import FuncTorrent.Logger (initLogger, logMessage, logStop) import FuncTorrent.Metainfo (announce, lengthInBytes, mkMetaInfo, info, name) -import FuncTorrent.Peer (peers, getPeerResponse, handShakeMsg) +import FuncTorrent.Peer (peers, mkPeerResp, handShakeMsg) import FuncTorrent.Tracker (connect, prepareRequest) logError :: ParseError -> (String -> IO ()) -> IO () @@ -53,16 +53,21 @@ main = do (Bdict d') = d logMsg "Trying to fetch peers: " - body <- connect (announce m) (prepareRequest d' peerId len) - - -- TODO: Write to ~/.functorrent/caches - writeFile (name (info m) ++ ".cache") body - - let peerResponse = show $ peers $ getPeerResponse body - logMsg $ "Peers List : " ++ peerResponse + response <- connect (announce m) (prepareRequest d' peerId len) let hsMsgLen = show $ length $ handShakeMsg d' peerId logMsg $ "Hand-shake message length : " ++ hsMsgLen + -- TODO: Write to ~/.functorrent/caches + writeFile (name (info m) ++ ".cache") response + + case decode response of + Right trackerInfo -> + case mkPeerResp trackerInfo of + Right peerResp -> + logMsg $ "Peers List : " ++ (show . peers $ peerResp) + Left e -> logMsg $ "Error" ++ unpack e + Left e -> logError e logMsg + Left e -> logError e logMsg logStop logR diff --git a/test/Test.hs b/test/Test.hs index 1976441..fd3a7ef 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -2,23 +2,14 @@ module Main where import Prelude hiding (readFile) -import Data.ByteString.Char8 (readFile) +import Data.ByteString.Char8 (ByteString, readFile) import Data.Map.Strict (fromList) import Test.Tasty import Test.Tasty.HUnit import FuncTorrent.Bencode (decode, BVal(..)) -import FuncTorrent.Peer (Peer(..), PeerResp(..), getPeerResponse) - --- Initial response from tracker -response :: PeerResp -response = PeerResp { - 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, - incomplete = Nothing - } +import FuncTorrent.Peer (Peer(..), PeerResp(..), mkPeerResp) -- Parsed .torrent file file :: BVal @@ -43,13 +34,34 @@ testFile = testCase "Should parse regular torrent files" $ do Right expected -> expected @?= file Left _ -> error "Failed parsing test file" -testResponse :: TestTree -testResponse = testCase "Should parse tracker response" $ do - str <- readFile "./data/debian-7.8.0-amd64-CD-1.iso.cache" - response @?= getPeerResponse str +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 + Left _ -> error "Failed parsing test file" + where + expectation :: Either a PeerResp + expectation = Right PeerResp { + 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, + incomplete = Nothing + } + +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 + Left _ -> error "Failed parsing test file" + where + expectation :: Either ByteString a + expectation = Left "torrent not found" + unitTests :: TestTree -unitTests = testGroup "Unit tests" [testFile, testResponse] +unitTests = testGroup "Unit tests" [testFile, testResponse1, testResponse2] tests :: TestTree tests = testGroup "Tests" [unitTests] -- 2.37.2