Misc fixes to http tracker.

[functorrent.git] / src / FuncTorrent / Tracker / Udp.hs

diff --git a/src/FuncTorrent/Tracker/Udp.hs b/src/FuncTorrent/Tracker/Udp.hs
index 4e541a932b2e17c5c20a8cb20cc48b7065689889..37979c494e7840ca96a2a4aeb5945eca8edd53d6 100644 (file)
--- a/src/FuncTorrent/Tracker/Udp.hs
+++ b/src/FuncTorrent/Tracker/Udp.hs
@@ -27,20 +27,19 @@ 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.Binary.Get (Get, isEmpty, getWord32be, getWord64be, getByteString)
 import Data.Binary.Put (putWord16be, putWord64be, putWord32be, putByteString)
 import Data.ByteString (ByteString)
 import qualified Data.ByteString.Char8 as BC
 import Data.ByteString.Lazy (fromStrict, toStrict)
 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 (Socket, Family( AF_INET ), SocketType( Datagram ), defaultProtocol, SockAddr(..), socket, 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 FuncTorrent.Tracker.Types (TrackerEventState(..), TState(..))
+import FuncTorrent.Utils (IP, Port, toIP, toPort, getHostname, getPort)
 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
@@ -94,10 +93,10 @@ instance Binary UDPRequest where
     putWord64be (fromIntegral down)
     putWord64be (fromIntegral left)
     putWord64be (fromIntegral up)
-    putWord32be $ fromIntegral (eventToInteger None)
+    putWord32be $ fromIntegral (eventToInteger event)
     putWord32be 0
-    -- key is optional, we will not send it for now
-    putWord32be $ fromIntegral (-1)
+    putWord32be 0
+    putWord32be 10
     putWord16be $ fromIntegral port
   put (ScrapeReq _ _ _) = undefined
   get = undefined
@@ -107,7 +106,7 @@ instance Binary UDPResponse where
   get = do
     a <- getWord32be -- action
     case a of
-      0 -> liftA2 ConnectResp (fromIntegral <$> getWord32be) (fromIntegral <$> getWord32be)
+      0 -> liftA2 ConnectResp (fromIntegral <$> getWord32be) (fromIntegral <$> getWord64be)
       1 -> do
         tid <- fromIntegral <$> getWord32be
         interval' <- fromIntegral <$> getWord32be
@@ -161,12 +160,11 @@ connectResponse tid = do
         return 0
     _                      -> return 0
 
-announceRequest :: Word64 -> ByteString -> Word64 -> Word64 -> Word64 -> Word16 -> ReaderT UDPTrackerHandle IO Word32
-announceRequest cid infohash up down left port = do
+announceRequest :: Word64 -> ByteString -> String -> Word64 -> Word64 -> Word64 -> Word16 -> ReaderT UDPTrackerHandle IO Word32
+announceRequest cid infohash peerId 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
+  let pkt = encode $ AnnounceReq cid tidi infohash peerId down left up None port
   liftIO $ sendRequest h (toStrict pkt)
   return tidi
 
@@ -195,7 +193,7 @@ getIPPortPairs = do
   if empty
     then return []
     else do
-    ip <- toIP <$> getByteString 6
+    ip <- toIP <$> getByteString 4
     port <- toPort <$> getByteString 2
     ipportpairs <- getIPPortPairs
     return $ (ip, port) : ipportpairs
@@ -205,24 +203,27 @@ startSession host port = do
   s <- socket AF_INET Datagram defaultProtocol
   addrinfos <- getAddrInfo Nothing (Just host) (Just (show port))
   let (SockAddrInet p ip) = addrAddress $ head addrinfos
-  hostAddr <- inet_addr (show ip)
   putStrLn "connected to tracker"
-  return $ UDPTrackerHandle { sock = s
-                            , addr = (SockAddrInet (fromIntegral port) hostAddr) }
+  return UDPTrackerHandle { sock = s
+                          , addr = (SockAddrInet (fromIntegral port) ip) }
   
 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
+trackerLoop url sport 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
+      port = getPort url
+      host = getHostname url
+  putStrLn $ "host = " ++ (show host) ++ " port= " ++ (show port)
+  handle <- startSession host port
   flip runReaderT handle $ do
     t1 <- connectRequest
     cid <- connectResponse t1
-    t2 <- announceRequest cid infohash (fromIntegral up) (fromIntegral down) (fromIntegral (left tstate)) (fromIntegral port)
+    t2 <- announceRequest cid infohash peerId (fromIntegral up) (fromIntegral down) (fromIntegral (left tstate)) (fromIntegral sport)
     stats <- announceResponse t2
     liftIO $ print stats
+--    _ <- threadDelay $