From: Ramakrishnan Muthukrishnan <ram@rkrishnan.org>
Date: Thu, 26 Mar 2015 10:48:07 +0000 (+0530)
Subject: support for announce-list.
X-Git-Url: https://git.rkrishnan.org/frontends/provisioning?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