From: Ramakrishnan Muthukrishnan Date: Sun, 4 Oct 2015 09:59:10 +0000 (+0530) Subject: WIP: udp tracker: get the peer ip, port pairs X-Git-Url: https://git.rkrishnan.org/?a=commitdiff_plain;h=137c5d51ed6614200110a45eaec97438c814e92e;p=functorrent.git WIP: udp tracker: get the peer ip, port pairs --- diff --git a/src/FuncTorrent/Tracker.hs b/src/FuncTorrent/Tracker.hs index 7e64f82..f995f1b 100644 --- a/src/FuncTorrent/Tracker.hs +++ b/src/FuncTorrent/Tracker.hs @@ -12,7 +12,7 @@ import Control.Concurrent (threadDelay) import Control.Concurrent.MVar (MVar, newEmptyMVar, newMVar, readMVar, putMVar) import Data.Binary (Binary(..)) import Data.Binary.Put (putWord16be, putWord32be, putWord64be, putByteString) -import Data.Binary.Get (getWord16be, getWord32be) +import Data.Binary.Get (Get, isEmpty, getByteString, getWord16be, getWord32be) import Data.ByteString (ByteString) import Data.ByteString.Char8 as BC (pack, unpack, splitAt) import Data.Char (chr) @@ -56,13 +56,16 @@ data Action = Connect | Scrape deriving (Show, Eq) +type IP = String +type Port = Integer + data UDPRequest = ConnectReq Integer | AnnounceReq Integer Integer ByteString String Integer Integer Integer TrackerEventState Integer | ScrapeReq Integer Integer ByteString deriving (Show, Eq) -data UDPResponse = ConnectResp Integer Integer - | AnnounceResp Integer Integer Integer Integer Integer Integer +data UDPResponse = ConnectResp Integer Integer -- transaction_id connection_id + | AnnounceResp Integer Integer Integer Integer [(IP, Port)] -- transaction_id interval leechers seeders [(ip, port)] | ScrapeResp Integer Integer Integer Integer deriving (Show, Eq) @@ -115,9 +118,8 @@ instance Binary UDPResponse where interval' <- fromIntegral <$> getWord32be _ <- getWord32be -- leechers _ <- getWord32be -- seeders - _ <- getWord32be -- ip - _ <- getWord16be -- port - return $ AnnounceResp tid interval' 0 0 0 0 + ipportpairs <- getIPPortPairs -- [(ip, port)] + return $ AnnounceResp tid interval' 0 0 ipportpairs 2 -> do tid <- fromIntegral <$> getWord32be _ <- getWord32be @@ -126,6 +128,17 @@ instance Binary UDPResponse where return $ ScrapeResp tid 0 0 0 _ -> error ("unknown response action type: " ++ show a) +getIPPortPairs :: Get [(IP, Port)] +getIPPortPairs = do + empty <- isEmpty + if empty + then return [] + else do + ip <- toIP <$> getByteString 6 + port <- toPort <$> getByteString 2 + ipportpairs <- getIPPortPairs + return $ (ip, port) : ipportpairs + initialTrackerState :: Integer -> IO TState initialTrackerState sz = do ps <- newEmptyMVar @@ -156,20 +169,20 @@ mkTrackerResponse resp = where (Bdict body) = resp - toInt :: String -> Integer - toInt = read +toInt :: String -> Integer +toInt = read - toPort :: ByteString -> Integer - toPort = read . ("0x" ++) . unpack . B16.encode +makePeer :: ByteString -> Peer +makePeer peer = Peer "" (toIP ip') (toPort port') + where (ip', port') = splitAt 4 peer - toIP :: ByteString -> String - toIP = Data.List.intercalate "." . - map (show . toInt . ("0x" ++) . unpack) . - splitN 2 . B16.encode +toPort :: ByteString -> Port +toPort = read . ("0x" ++) . unpack . B16.encode - makePeer :: ByteString -> Peer - makePeer peer = Peer "" (toIP ip') (toPort port') - where (ip', port') = splitAt 4 peer +toIP :: ByteString -> IP +toIP = Data.List.intercalate "." . + map (show . toInt . ("0x" ++) . unpack) . + splitN 2 . B16.encode --- | URL encode hash as per RFC1738 --- TODO: Add tests