) where
import Control.Applicative (liftA2)
-import Control.Monad (liftM, forever, void)
+import Control.Monad (forever, void)
import Control.Concurrent (threadDelay)
import Control.Concurrent.MVar (readMVar, putMVar, isEmptyMVar, swapMVar)
import Control.Monad.Reader (ReaderT, runReaderT, ask, liftIO)
import FuncTorrent.PeerMsgs (Peer(..))
import FuncTorrent.Tracker.Types (TrackerEventState(..), TState(..), UdpTrackerResponse(..))
-import FuncTorrent.Utils (IP, Port, toIP, toPort, getHostname, getPort)
+import FuncTorrent.Utils (Port, toIP, toPort, getHostname, getPort)
import qualified FuncTorrent.FileSystem as FS (MsgChannel, Stats(..), getStats)
-- UDP tracker: http://bittorrent.org/beps/bep_0015.html
data UDPTrackerHandle = UDPTrackerHandle { sock :: Socket
, addr :: SockAddr
- , tid :: Word32
}
actionToInteger :: Action -> Integer
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
putWord64be 0x41727101980
putWord32be $ fromIntegral (actionToInteger Connect)
putWord32be (fromIntegral transId)
- put (AnnounceReq connId transId infohash peerId down left up event port) = do
+ 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 left')
putWord64be (fromIntegral up)
putWord32be $ fromIntegral (eventToInteger event)
putWord32be 0
case a of
0 -> liftA2 ConnectResp (fromIntegral <$> getWord32be) (fromIntegral <$> getWord64be)
1 -> do
- tid <- fromIntegral <$> getWord32be
+ tid' <- fromIntegral <$> getWord32be
interval' <- fromIntegral <$> getWord32be
l <- getWord32be -- leechers
s <- getWord32be -- seeders
ipportpairs <- getIPPortPairs -- [(ip, port)]
- return $ AnnounceResp tid interval' l s ipportpairs
+ return $ AnnounceResp tid' interval' l s ipportpairs
2 -> do
- tid <- fromIntegral <$> getWord32be
+ tid' <- fromIntegral <$> getWord32be
_ <- getWord32be
_ <- getWord32be
_ <- getWord32be
- return $ ScrapeResp tid 0 0 0
+ return $ ScrapeResp tid' 0 0 0
3 -> do -- error response
- tid <- fromIntegral <$> getWord32be
+ tid' <- fromIntegral <$> getWord32be
bs <- getByteString 4
- return $ ErrorResp tid $ BC.unpack bs
+ return $ ErrorResp tid' $ BC.unpack bs
_ -> error ("unknown response action type: " ++ show a)
sendRequest :: UDPTrackerHandle -> ByteString -> IO ()
_ -> return 0
announceRequest :: Word64 -> ByteString -> String -> Word64 -> Word64 -> Word64 -> Word16 -> ReaderT UDPTrackerHandle IO Word32
-announceRequest cid infohash peerId up down left port = do
+announceRequest cid infohash peerId up down left' port = do
h <- ask
tidi <- liftIO randomIO
- let pkt = encode $ AnnounceReq cid tidi infohash peerId down left up None port
+ let pkt = encode $ AnnounceReq cid tidi infohash peerId down left' up None port
liftIO $ sendRequest h (toStrict pkt)
return tidi
h <- ask
resp <- liftIO $ recvResponse h
case resp of
- (AnnounceResp tidr interval ss ls xs) ->
+ (AnnounceResp tidr interval' ss ls xs) ->
if tidr == tid
then do
liftIO $ putStrLn "announce succeeded"
- return $ UdpTrackerResponse ls ss interval xs
+ return $ UdpTrackerResponse ls ss interval' xs
else
return $ UdpTrackerResponse 0 0 0 []
_ -> return $ UdpTrackerResponse 0 0 0 []
, addr = (SockAddrInet (fromIntegral port) ip) }
closeSession :: UDPTrackerHandle -> IO ()
-closeSession (UDPTrackerHandle s _ _) = close s
+closeSession (UDPTrackerHandle s _) = close s
trackerLoop :: String -> PortNumber -> String -> ByteString -> FS.MsgChannel -> TState -> IO ()
trackerLoop url sport peerId infohash fschan tstate = forever $ do
up <- fmap FS.bytesRead st
down <- fmap FS.bytesWritten st
handle <- startSession host port
- stats <- timeout (15*(10^6)) $ worker handle up down
+ stats <- timeout (15*oneSec) $ worker handle up down
case stats of
Nothing -> closeSession handle
Just stats' -> do
putMVar (connectedPeers tstate) (peers stats')
else
void $ swapMVar (connectedPeers tstate) (peers stats')
- threadDelay $ fromIntegral (interval stats') * (10^6)
+ threadDelay $ fromIntegral (interval stats') * oneSec
return ()
where
+ oneSec = 1000000
port = getPort url
host = getHostname url
worker handle up down = flip runReaderT handle $ do