From: Ramakrishnan Muthukrishnan Date: Thu, 26 Mar 2015 10:48:07 +0000 (+0530) Subject: support for announce-list. X-Git-Url: https://git.rkrishnan.org/pf/content/en/footer/frontends/%3C?a=commitdiff_plain;h=16debefeb14f3b38e2d18f9ba5bd8722e485d7ec;p=functorrent.git support for announce-list. Some torrent files use announce-lists but then store list of lists, each inner list containing just one string instead of list of strings. (eg: data/ubuntu-14.10-desktop-amd64.iso.torrent stores it this way) --- diff --git a/src/FuncTorrent/Metainfo.hs b/src/FuncTorrent/Metainfo.hs index 822a405..dad0865 100644 --- a/src/FuncTorrent/Metainfo.hs +++ b/src/FuncTorrent/Metainfo.hs @@ -6,7 +6,8 @@ module FuncTorrent.Metainfo announce, lengthInBytes, info, - name + name, + getTrackers ) where import Prelude hiding (lookup) @@ -25,8 +26,8 @@ data Info = Info { pieceLength :: !Integer } deriving (Eq, Show) data Metainfo = Metainfo { info :: !Info - , announce :: !String - , announceList :: !(Maybe [[String]]) + , announce :: !(Maybe String) + , announceList :: ![String] , creationDate :: !(Maybe String) , comment :: !(Maybe String) , createdBy :: !(Maybe String) @@ -55,20 +56,39 @@ maybeBstrToString (Just s) = let (Bstr bs) = s mkMetaInfo :: BVal -> Maybe Metainfo mkMetaInfo (Bdict m) = let (Just info') = mkInfo $ m ! "info" - (Bstr announce') = m ! "announce" - -- announceList = lookup (Bstr (pack "announce list")) - announceList' = Nothing + announce' = lookup "announce" m + announceList' = lookup "announce-list" m -- creationDate = lookup (Bstr (pack "creation date")) m creationDate' = Nothing comment' = lookup "comment" m createdBy' = lookup "created by" m encoding' = lookup "encoding" m in Just Metainfo { info = info' - , announce = unpack announce' - , announceList = announceList' + , announce = announce' + >>= (\(Bstr a) -> + Just (unpack a)) + , announceList = getAnnounceList announceList' , creationDate = creationDate' , comment = maybeBstrToString comment' , createdBy = maybeBstrToString createdBy' , encoding = maybeBstrToString encoding' } mkMetaInfo _ = Nothing + +getAnnounceList :: Maybe BVal -> [String] +getAnnounceList Nothing = [] +getAnnounceList (Just (Bint _)) = [] +getAnnounceList (Just (Bstr _)) = [] +getAnnounceList (Just (Blist l)) = map (\s -> case s of + (Bstr s') -> unpack s' + (Blist s') -> case s' of + [Bstr s''] -> unpack s'' + _ -> "" + _ -> "") l + +getAnnounceList (Just (Bdict _)) = [] + +getTrackers :: Metainfo -> [String] +getTrackers m = case (announce m) of + Nothing -> announceList m + Just a -> a : announceList m diff --git a/src/Main.hs b/src/Main.hs index 7757331..c0a37c1 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -10,7 +10,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.Metainfo (announce, lengthInBytes, mkMetaInfo, info, name, getTrackers) import FuncTorrent.Peer (peers, mkPeerResp, handShakeMsg) import FuncTorrent.Tracker (connect, prepareRequest) @@ -51,9 +51,10 @@ main = do let len = lengthInBytes $ info m (Bdict d') = d + trackers = getTrackers m logMsg "Trying to fetch peers: " - response <- connect (announce m) (prepareRequest d' peerId len) + response <- connect (head trackers) (prepareRequest d' peerId len) let hsMsgLen = show $ length $ handShakeMsg d' peerId logMsg $ "Hand-shake message length : " ++ hsMsgLen