WIP: udp tracker: get the peer ip, port pairs

diff --git a/src/FuncTorrent/Tracker.hs b/src/FuncTorrent/Tracker.hs
index 7e64f82a4836ab8db13a832a5c7703a9db5593ce..f995f1be3d6e04663399a602ef72e3a177b596ee 100644 (file)
--- 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 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)
 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)
 
             | 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 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)
 
                  | ScrapeResp Integer Integer Integer Integer
                  deriving (Show, Eq)
 


@@ -115,9 +118,8 @@ instance Binary UDPResponse where
         interval' <- fromIntegral <$> getWord32be
         _ <- getWord32be -- leechers
         _ <- getWord32be -- seeders
         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
       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)
 
         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
 initialTrackerState :: Integer -> IO TState
 initialTrackerState sz = do
   ps <- newEmptyMVar


@@ -156,20 +169,20 @@ mkTrackerResponse resp =
     where
       (Bdict body) = 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
 
 --- | URL encode hash as per RFC1738
 --- TODO: Add tests