{-# LANGUAGE OverloadedStrings #-}
module FuncTorrent.Tracker.Udp
- (
+ (trackerLoop
) where
import Control.Applicative (liftA2)
+import Control.Monad (liftM)
+import Control.Concurrent.MVar (readMVar)
import Control.Monad.Reader (ReaderT, runReaderT, ask, liftIO)
import Data.Binary (Binary(..), encode, decode)
import Data.Binary.Get (Get, isEmpty, getWord32be, getByteString)
import Data.ByteString (ByteString)
import qualified Data.ByteString.Char8 as BC
import Data.ByteString.Lazy (fromStrict, toStrict)
-import Data.Word (Word32, Word64)
-import Network.Socket (Socket, Family( AF_INET ), SocketType( Datagram ), defaultProtocol, SockAddr(..), socket, inet_addr, close)
+import Data.Word (Word16, Word32, Word64)
+import Network.Socket (Socket, Family( AF_INET ), SocketType( Datagram ), defaultProtocol, SockAddr(..), socket, inet_addr, close, getAddrInfo, addrAddress, SockAddr(..))
import Network.Socket.ByteString (sendTo, recvFrom)
import System.Random (randomIO)
import FuncTorrent.Tracker.Types (TrackerEventState(..))
import FuncTorrent.Utils (IP, Port, toIP, toPort)
+import qualified FuncTorrent.FileSystem as FS (MsgChannel, Stats(..), getStats)
+import FuncTorrent.Tracker.Types(TState(..))
-- UDP tracker: http://bittorrent.org/beps/bep_0015.html
data Action = Connect
deriving (Show, Eq)
data UDPRequest = ConnectReq Word32
- | AnnounceReq Integer Integer ByteString String Integer Integer Integer TrackerEventState Integer
+ | AnnounceReq Word64 Word32 ByteString String Word64 Word64 Word64 TrackerEventState Word16
| ScrapeReq Integer Integer ByteString
deriving (Show, Eq)
data UDPResponse = ConnectResp Word32 Word64 -- transaction_id connection_id
- | AnnounceResp Integer Integer Integer Integer [(IP, Port)] -- transaction_id interval leechers seeders [(ip, port)]
+ | AnnounceResp Word32 Word32 Word32 Word32 [(IP, Port)] -- transaction_id interval leechers seeders [(ip, port)]
| ScrapeResp Integer Integer Integer Integer
| ErrorResp Integer String
deriving (Show, Eq)
eventToInteger None = 0
eventToInteger Completed = 1
eventToInteger Started = 2
+eventToInteger Stopped = 3
instance Binary UDPRequest where
put (ConnectReq transId) = do
1 -> do
tid <- fromIntegral <$> getWord32be
interval' <- fromIntegral <$> getWord32be
- _ <- getWord32be -- leechers
- _ <- getWord32be -- seeders
+ l <- getWord32be -- leechers
+ s <- getWord32be -- seeders
ipportpairs <- getIPPortPairs -- [(ip, port)]
- return $ AnnounceResp tid interval' 0 0 ipportpairs
+ return $ AnnounceResp tid interval' l s ipportpairs
2 -> do
tid <- fromIntegral <$> getWord32be
_ <- getWord32be
recvResponse :: UDPTrackerHandle -> IO UDPResponse
recvResponse h = do
- (bs, saddr) <- recvFrom (sock h) 32
+ (bs, saddr) <- recvFrom (sock h) (16*1024)
return $ decode $ fromStrict bs
-connectRequest :: ReaderT UDPTrackerHandle IO ()
+connectRequest :: ReaderT UDPTrackerHandle IO Word32
connectRequest = do
h <- ask
- let pkt = encode $ ConnectReq (tid h)
+ tidi <- liftIO randomIO
+ let pkt = encode $ ConnectReq tidi
liftIO $ sendRequest h (toStrict pkt)
+ return tidi
-connectResponse :: Word32 -> ReaderT UDPTrackerHandle IO Bool
-connectResponse itid = do
+connectResponse :: Word32 -> ReaderT UDPTrackerHandle IO Word64
+connectResponse tid = do
h <- ask
resp <- liftIO $ recvResponse h
-- check if nbytes is at least 16 bytes long
case resp of
- (ConnectResp tid cid) -> return $ tid == itid
- _ -> return False
+ (ConnectResp tidr cid) ->
+ if tidr == tid
+ then do
+ liftIO $ putStrLn "connect succeeded"
+ return cid
+ else
+ return 0
+ _ -> return 0
+
+announceRequest :: Word64 -> ByteString -> Word64 -> Word64 -> Word64 -> Word16 -> ReaderT UDPTrackerHandle IO Word32
+announceRequest cid infohash up down left port = do
+ h <- ask
+ tidi <- liftIO randomIO
+ -- connId transId infohash peerId down left up event port)
+ let pkt = encode $ AnnounceReq cid tidi infohash "foo" down left up None port
+ liftIO $ sendRequest h (toStrict pkt)
+ return tidi
+
+data PeerStats = PeerStats { leechers :: Word32
+ , seeders :: Word32
+ , peers :: [(IP, Port)]
+ } deriving (Show)
+
+announceResponse :: Word32 -> ReaderT UDPTrackerHandle IO PeerStats
+announceResponse tid = do
+ h <- ask
+ resp <- liftIO $ recvResponse h
+ case resp of
+ (AnnounceResp tidr interval ss ls xs) ->
+ if tidr == tid
+ then do
+ liftIO $ putStrLn "announce succeeded"
+ return $ PeerStats ls ss xs
+ else
+ return $ PeerStats 0 0 []
+ _ -> return $ PeerStats 0 0 []
getIPPortPairs :: Get [(IP, Port)]
getIPPortPairs = do
ipportpairs <- getIPPortPairs
return $ (ip, port) : ipportpairs
-startSession :: IP -> Port -> IO UDPTrackerHandle
-startSession ip port = do
+startSession :: String -> Port -> IO UDPTrackerHandle
+startSession host port = do
s <- socket AF_INET Datagram defaultProtocol
- hostAddr <- inet_addr ip
+ addrinfos <- getAddrInfo Nothing (Just host) (Just (show port))
+ let (SockAddrInet p ip) = addrAddress $ head addrinfos
+ hostAddr <- inet_addr (show ip)
putStrLn "connected to tracker"
- r <- randomIO
return $ UDPTrackerHandle { sock = s
- , tid = r
, addr = (SockAddrInet (fromIntegral port) hostAddr) }
closeSession :: UDPTrackerHandle -> IO ()
closeSession (UDPTrackerHandle s _ _) = close s
+
+trackerLoop :: String -> Port -> String -> ByteString -> FS.MsgChannel -> TState -> IO ()
+trackerLoop host port peerId infohash fschan tstate = do
+ st' <- FS.getStats fschan
+ st <- readMVar st'
+ let up = FS.bytesRead st
+ down = FS.bytesWritten st
+ handle <- startSession host 2710
+ flip runReaderT handle $ do
+ t1 <- connectRequest
+ cid <- connectResponse t1
+ t2 <- announceRequest cid infohash (fromIntegral up) (fromIntegral down) (fromIntegral (left tstate)) (fromIntegral port)
+ stats <- announceResponse t2
+ liftIO $ print stats
projects / functorrent.git / blobdiff