src/FuncTorrent/Tracker/Udp.hs

   1 {-
   2  - Copyright (C) 2015-2016 Ramakrishnan Muthukrishnan <ram@rkrishnan.org>
   3  -
   4  - This file is part of FuncTorrent.
   5  -
   6  - FuncTorrent is free software; you can redistribute it and/or modify
   7  - it under the terms of the GNU General Public License as published by
   8  - the Free Software Foundation; either version 3 of the License, or
   9  - (at your option) any later version.
  10  -
  11  - FuncTorrent is distributed in the hope that it will be useful,
  12  - but WITHOUT ANY WARRANTY; without even the implied warranty of
  13  - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14  - GNU General Public License for more details.
  15  -
  16  - You should have received a copy of the GNU General Public License
  17  - along with FuncTorrent; if not,  see <http://www.gnu.org/licenses/>
  18  -}
  19
  20 {-# LANGUAGE OverloadedStrings #-}
  21 module FuncTorrent.Tracker.Udp
  22        (
  23        ) where
  24
  25 import Control.Applicative (liftA2)
  26 import Control.Monad.Reader (ReaderT, runReaderT, ask, liftIO)
  27 import Data.Binary (Binary(..), encode, decode)
  28 import Data.Binary.Get (Get, isEmpty, getWord32be, getByteString)
  29 import Data.Binary.Put (putWord16be, putWord64be, putWord32be, putByteString)
  30 import Data.ByteString (ByteString)
  31 import qualified Data.ByteString.Char8 as BC
  32 import Data.ByteString.Lazy (fromStrict, toStrict)
  33 import Data.Word (Word32, Word64)
  34 import Network.Socket (Socket, Family( AF_INET ), SocketType( Datagram ), defaultProtocol, SockAddr(..), socket, inet_addr, close)
  35 import Network.Socket.ByteString (sendTo, recvFrom)
  36 import System.Random (randomIO)
  37
  38 import FuncTorrent.Tracker.Types (TrackerEventState(..))
  39 import FuncTorrent.Utils (IP, Port, toIP, toPort)
  40
  41 -- UDP tracker: http://bittorrent.org/beps/bep_0015.html
  42 data Action = Connect
  43             | Announce
  44             | Scrape
  45             deriving (Show, Eq)
  46
  47 data UDPRequest = ConnectReq Word32
  48                 | AnnounceReq Integer Integer ByteString String Integer Integer Integer TrackerEventState Integer
  49                 | ScrapeReq Integer Integer ByteString
  50                 deriving (Show, Eq)
  51
  52 data UDPResponse = ConnectResp Word32 Word64 -- transaction_id connection_id
  53                  | AnnounceResp Integer Integer Integer Integer [(IP, Port)] -- transaction_id interval leechers seeders [(ip, port)]
  54                  | ScrapeResp Integer Integer Integer Integer
  55                  | ErrorResp Integer String
  56                  deriving (Show, Eq)
  57
  58 data UDPTrackerHandle = UDPTrackerHandle { sock :: Socket
  59                                          , addr :: SockAddr
  60                                          , tid  :: Word32
  61                                          }
  62
  63 actionToInteger :: Action -> Integer
  64 actionToInteger Connect  = 0
  65 actionToInteger Announce = 1
  66 actionToInteger Scrape   = 2
  67
  68 intToAction :: Integer -> Action
  69 intToAction 0 = Connect
  70 intToAction 1 = Announce
  71 intToAction 2 = Scrape
  72
  73 eventToInteger :: TrackerEventState -> Integer
  74 eventToInteger None = 0
  75 eventToInteger Completed = 1
  76 eventToInteger Started = 2
  77
  78 instance Binary UDPRequest where
  79   put (ConnectReq transId) = do
  80     putWord64be 0x41727101980
  81     putWord32be $ fromIntegral (actionToInteger Connect)
  82     putWord32be (fromIntegral transId)
  83   put (AnnounceReq connId transId infohash peerId down left up event port) = do
  84     putWord64be $ fromIntegral connId
  85     putWord32be $ fromIntegral (actionToInteger Announce)
  86     putWord32be $ fromIntegral transId
  87     putByteString infohash
  88     putByteString (BC.pack peerId)
  89     putWord64be (fromIntegral down)
  90     putWord64be (fromIntegral left)
  91     putWord64be (fromIntegral up)
  92     putWord32be $ fromIntegral (eventToInteger None)
  93     putWord32be 0
  94     -- key is optional, we will not send it for now
  95     putWord32be $ fromIntegral (-1)
  96     putWord16be $ fromIntegral port
  97   put (ScrapeReq _ _ _) = undefined
  98   get = undefined
  99
 100 instance Binary UDPResponse where
 101   put = undefined
 102   get = do
 103     a <- getWord32be -- action
 104     case a of
 105       0 -> liftA2 ConnectResp (fromIntegral <$> getWord32be) (fromIntegral <$> getWord32be)
 106       1 -> do
 107         tid <- fromIntegral <$> getWord32be
 108         interval' <- fromIntegral <$> getWord32be
 109         _ <- getWord32be -- leechers
 110         _ <- getWord32be -- seeders
 111         ipportpairs <- getIPPortPairs -- [(ip, port)]
 112         return $ AnnounceResp tid interval' 0 0 ipportpairs
 113       2 -> do
 114         tid <- fromIntegral <$> getWord32be
 115         _ <- getWord32be
 116         _ <- getWord32be
 117         _ <- getWord32be
 118         return $ ScrapeResp tid 0 0 0
 119       3 -> do -- error response
 120         tid <- fromIntegral <$> getWord32be
 121         bs  <- getByteString 4
 122         return $ ErrorResp tid $ BC.unpack bs
 123       _ -> error ("unknown response action type: " ++ show a)
 124
 125 sendRequest :: UDPTrackerHandle -> ByteString -> IO ()
 126 sendRequest h req = do
 127   n <- sendTo (sock h) req (addr h)
 128   -- sanity check with n?
 129   return ()
 130
 131 recvResponse :: UDPTrackerHandle -> IO UDPResponse
 132 recvResponse h = do
 133   (bs, saddr) <- recvFrom (sock h) 32
 134   return $ decode $ fromStrict bs
 135
 136 connectRequest :: ReaderT UDPTrackerHandle IO ()
 137 connectRequest = do
 138   h <- ask
 139   let pkt = encode $ ConnectReq (tid h)
 140   liftIO $ sendRequest h (toStrict pkt)
 141
 142 connectResponse :: Word32 -> ReaderT UDPTrackerHandle IO Bool
 143 connectResponse itid = do
 144   h <- ask
 145   resp <- liftIO $ recvResponse h
 146   -- check if nbytes is at least 16 bytes long
 147   case resp of
 148     (ConnectResp tid cid) -> return $ tid == itid
 149     _                     -> return False
 150
 151 getIPPortPairs :: Get [(IP, Port)]
 152 getIPPortPairs = do
 153   empty <- isEmpty
 154   if empty
 155     then return []
 156     else do
 157     ip <- toIP <$> getByteString 6
 158     port <- toPort <$> getByteString 2
 159     ipportpairs <- getIPPortPairs
 160     return $ (ip, port) : ipportpairs
 161
 162 startSession :: IP -> Port -> IO UDPTrackerHandle
 163 startSession ip port = do
 164   s <- socket AF_INET Datagram defaultProtocol
 165   hostAddr <- inet_addr ip
 166   putStrLn "connected to tracker"
 167   r <- randomIO
 168   return $ UDPTrackerHandle { sock = s
 169                             , tid = r
 170                             , addr = (SockAddrInet (fromIntegral port) hostAddr) }
 171
 172 closeSession :: UDPTrackerHandle -> IO ()
 173 closeSession (UDPTrackerHandle s _ _) = close s