From: Ramakrishnan Muthukrishnan Date: Sat, 11 Jun 2016 16:45:59 +0000 (+0530) Subject: WIP: UDP tracker X-Git-Url: https://git.rkrishnan.org/about.html?a=commitdiff_plain;h=1333f3f066c8f3666b8493dd05a2ad26395f3fa3;p=functorrent.git WIP: UDP tracker --- diff --git a/src/FuncTorrent/Tracker/Udp.hs b/src/FuncTorrent/Tracker/Udp.hs new file mode 100644 index 0000000..aa7bfd5 --- /dev/null +++ b/src/FuncTorrent/Tracker/Udp.hs @@ -0,0 +1,175 @@ +{- + - Copyright (C) 2015-2016 Ramakrishnan Muthukrishnan + - + - This file is part of FuncTorrent. + - + - FuncTorrent is free software; you can redistribute it and/or modify + - it under the terms of the GNU General Public License as published by + - the Free Software Foundation; either version 3 of the License, or + - (at your option) any later version. + - + - FuncTorrent is distributed in the hope that it will be useful, + - but WITHOUT ANY WARRANTY; without even the implied warranty of + - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + - GNU General Public License for more details. + - + - You should have received a copy of the GNU General Public License + - along with FuncTorrent; if not, see + -} + +{-# LANGUAGE OverloadedStrings #-} +module Functorrent.Tracker.Udp + ( + ) where + +import Control.Applicative (liftA2) +import Control.Monad.Error (ErrorT) +import Control.Monad.Reader (ReaderT, runReaderT, ask) +import Data.Binary (Binary(..), encode, decode) +import Data.Binary.Get (Get, isEmpty, getWord32be, getByteString) +import Data.Binary.Put (putWord16be, putWord64be, putWord32be, putByteString) +import Data.ByteString.Char8 as BC +import Data.ByteString.Lazy (fromStrict) +import Data.Word (Word32) +import Network.Socket (Socket, SockAddr, sendTo, recvFrom) +import System.Random (randomIO) + +import FuncTorrent.Tracker.Types (TrackerEventState(..), IP, Port) + +-- UDP tracker: http://bittorrent.org/beps/bep_0015.html +data Action = Connect + | Announce + | Scrape + deriving (Show, Eq) + +data UDPRequest = ConnectReq Word32 + | AnnounceReq Integer Integer ByteString String Integer Integer Integer TrackerEventState Integer + | ScrapeReq Integer Integer ByteString + deriving (Show, Eq) + +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 + | ErrorResp Integer String + deriving (Show, Eq) + +data UDPTrackerHandle = UDPTrackerHandle { sock :: Socket + , addr :: SockAddr + , tid :: Word32 + } + +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 + +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 + ipportpairs <- getIPPortPairs -- [(ip, port)] + return $ AnnounceResp tid interval' 0 0 ipportpairs + 2 -> do + tid <- fromIntegral <$> getWord32be + _ <- getWord32be + _ <- getWord32be + _ <- getWord32be + return $ ScrapeResp tid 0 0 0 + 3 -> do -- error response + tid <- fromIntegral <$> getWord32be + bs <- getByteString 4 + return $ ErrorResp tid $ unpack bs + _ -> error ("unknown response action type: " ++ show a) + +sendRequest :: UDPTrackerHandle -> UDPRequest -> IO () +sendRequest h req = do + n <- sendTo (sock h) req (addr h) + -- sanity check with n? + return () + +recvResponse :: UDPTrackerHandle -> ErrorT String IO UDPResponse +recvResponse h = do + (bs, nbytes, saddr) <- recvFrom (sock h) 20 + -- check if nbytes is at least 16 bytes long + return $ decode $ fromStrict bs + +connectRequest :: ReaderT UDPTrackerHandle IO Integer +connectRequest = do + h <- ask + let pkt = encode $ ConnectReq (tid h) + sendRequest h pkt + +connectResponse :: ReaderT UDPTrackerHandle IO Bool +connectResponse = do + h <- ask + + +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 + +getResponse :: Socket -> IO UDPResponse +getResponse s = do + -- connect packet is 16 bytes long + -- announce packet is atleast 20 bytes long + bs <- recv s (16*1024) + return $ decode $ fromStrict bs + + +udpTrackerLoop :: PortNumber -> String -> Metainfo -> TState -> IO String +udpTrackerLoop port peerId m st = do + -- h <- connectTo "exodus.desync.com" (PortNumber 6969) + s <- socket AF_INET Datagram defaultProtocol + hostAddr <- inet_addr "185.37.101.229" + putStrLn "connected to tracker" + _ <- sendTo s (toStrict $ encode (ConnectReq 42)) (SockAddrInet 2710 hostAddr) + putStrLn "--> sent ConnectReq to tracker" + resp <- recv s 16 + putStrLn "<-- recv ConnectResp from tracker" + return $ show resp