From: Ramakrishnan Muthukrishnan Date: Sun, 4 Oct 2015 06:27:03 +0000 (+0530) Subject: WIP: UDP Tracker support X-Git-Url: https://git.rkrishnan.org/?a=commitdiff_plain;h=9f269b2c187fe1080620b3960a4aeae88ff4abc8;p=functorrent.git WIP: UDP Tracker support Add binary packet creation/parsing of the UDP request and response packets. --- diff --git a/src/FuncTorrent/Tracker.hs b/src/FuncTorrent/Tracker.hs index 3926a12..7e64f82 100644 --- a/src/FuncTorrent/Tracker.hs +++ b/src/FuncTorrent/Tracker.hs @@ -7,8 +7,12 @@ module FuncTorrent.Tracker import Prelude hiding (lookup, splitAt) +import Control.Applicative (liftA2) 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.ByteString (ByteString) import Data.ByteString.Char8 as BC (pack, unpack, splitAt) import Data.Char (chr) @@ -32,7 +36,8 @@ data TrackerResponse = TrackerResponse { , incomplete :: Maybe Integer } deriving (Show, Eq) -data TrackerEventState = Started +data TrackerEventState = None + | Started | Stopped | Completed deriving (Show, Eq) @@ -45,12 +50,88 @@ data TState = TState { , connectedPeers :: MVar [Peer] } +-- UDP tracker: http://bittorrent.org/beps/bep_0015.html +data Action = Connect + | Announce + | Scrape + 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 + | ScrapeResp Integer Integer Integer Integer + deriving (Show, Eq) + +actionToInteger :: Action -> Integer +actionToInteger Connect = 0 +actionToInteger Announce = 1 +actionToInteger Scrape = 2 + +intToAction :: Integer -> Action +intToAction 0 = Connect +intToAction 1 = Announce +intToAction 2 = Scrape + +eventToInteger :: TrackerEventState -> Integer +eventToInteger None = 0 +eventToInteger Completed = 1 +eventToInteger Started = 2 +eventToInteger Stopped = 3 + +instance Binary UDPRequest where + put (ConnectReq transId) = do + putWord64be 0x41727101980 + putWord32be $ fromIntegral (actionToInteger Connect) + putWord32be (fromIntegral transId) + put (AnnounceReq connId transId infohash peerId down left up event port) = do + putWord64be $ fromIntegral connId + putWord32be $ fromIntegral (actionToInteger Announce) + putWord32be $ fromIntegral transId + putByteString infohash + putByteString (BC.pack peerId) + putWord64be (fromIntegral down) + putWord64be (fromIntegral left) + putWord64be (fromIntegral up) + putWord32be $ fromIntegral (eventToInteger None) + putWord32be 0 + -- key is optional, we will not send it for now + putWord32be $ fromIntegral (-1) + putWord16be $ fromIntegral port + put (ScrapeReq _ _ _) = undefined + get = undefined + +instance Binary UDPResponse where + put = undefined + get = do + a <- getWord32be -- action + case a of + 0 -> liftA2 ConnectResp (fromIntegral <$> getWord32be) (fromIntegral <$> getWord32be) + 1 -> do + tid <- fromIntegral <$> getWord32be + interval' <- fromIntegral <$> getWord32be + _ <- getWord32be -- leechers + _ <- getWord32be -- seeders + _ <- getWord32be -- ip + _ <- getWord16be -- port + return $ AnnounceResp tid interval' 0 0 0 0 + 2 -> do + tid <- fromIntegral <$> getWord32be + _ <- getWord32be + _ <- getWord32be + _ <- getWord32be + return $ ScrapeResp tid 0 0 0 + _ -> error ("unknown response action type: " ++ show a) + initialTrackerState :: Integer -> IO TState initialTrackerState sz = do ps <- newEmptyMVar up <- newMVar 0 down <- newMVar 0 - return $ TState { currentState = Started + return $ TState { currentState = None , connectedPeers = ps , uploaded = up , downloaded = down