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.Error (ErrorT)
  27 import Control.Monad.Reader (ReaderT, runReaderT, ask)
  28 import Data.Binary (Binary(..), encode, decode)
  29 import Data.Binary.Get (Get, isEmpty, getWord32be, getByteString)
  30 import Data.Binary.Put (putWord16be, putWord64be, putWord32be, putByteString)
  31 import Data.ByteString.Char8 as BC
  32 import Data.ByteString.Lazy (fromStrict)
  33 import Data.Word (Word32)
  34 import Network.Socket (Socket, SockAddr, sendTo, recvFrom)
  35 import System.Random (randomIO)
  36
  37 import FuncTorrent.Tracker.Types (TrackerEventState(..), IP, Port)
  38
  39 -- UDP tracker: http://bittorrent.org/beps/bep_0015.html
  40 data Action = Connect
  41             | Announce
  42             | Scrape
  43             deriving (Show, Eq)
  44
  45 data UDPRequest = ConnectReq Word32
  46                 | AnnounceReq Integer Integer ByteString String Integer Integer Integer TrackerEventState Integer
  47                 | ScrapeReq Integer Integer ByteString
  48                 deriving (Show, Eq)
  49
  50 data UDPResponse = ConnectResp Integer Integer -- transaction_id connection_id
  51                  | AnnounceResp Integer Integer Integer Integer [(IP, Port)] -- transaction_id interval leechers seeders [(ip, port)]
  52                  | ScrapeResp Integer Integer Integer Integer
  53                  | ErrorResp Integer String
  54                  deriving (Show, Eq)
  55
  56 data UDPTrackerHandle = UDPTrackerHandle { sock :: Socket
  57                                          , addr :: SockAddr
  58                                          , tid  :: Word32
  59                                          }
  60
  61 actionToInteger :: Action -> Integer
  62 actionToInteger Connect  = 0
  63 actionToInteger Announce = 1
  64 actionToInteger Scrape   = 2
  65
  66 intToAction :: Integer -> Action
  67 intToAction 0 = Connect
  68 intToAction 1 = Announce
  69 intToAction 2 = Scrape
  70
  71 eventToInteger :: TrackerEventState -> Integer
  72 eventToInteger None = 0
  73 eventToInteger Completed = 1
  74 eventToInteger Started = 2
  75
  76 instance Binary UDPRequest where
  77   put (ConnectReq transId) = do
  78     putWord64be 0x41727101980
  79     putWord32be $ fromIntegral (actionToInteger Connect)
  80     putWord32be (fromIntegral transId)
  81   put (AnnounceReq connId transId infohash peerId down left up event port) = do
  82     putWord64be $ fromIntegral connId
  83     putWord32be $ fromIntegral (actionToInteger Announce)
  84     putWord32be $ fromIntegral transId
  85     putByteString infohash
  86     putByteString (BC.pack peerId)
  87     putWord64be (fromIntegral down)
  88     putWord64be (fromIntegral left)
  89     putWord64be (fromIntegral up)
  90     putWord32be $ fromIntegral (eventToInteger None)
  91     putWord32be 0
  92     -- key is optional, we will not send it for now
  93     putWord32be $ fromIntegral (-1)
  94     putWord16be $ fromIntegral port
  95   put (ScrapeReq _ _ _) = undefined
  96   get = undefined
  97
  98 instance Binary UDPResponse where
  99   put = undefined
 100   get = do
 101     a <- getWord32be -- action
 102     case a of
 103       0 -> liftA2 ConnectResp (fromIntegral <$> getWord32be) (fromIntegral <$> getWord32be)
 104       1 -> do
 105         tid <- fromIntegral <$> getWord32be
 106         interval' <- fromIntegral <$> getWord32be
 107         _ <- getWord32be -- leechers
 108         _ <- getWord32be -- seeders
 109         ipportpairs <- getIPPortPairs -- [(ip, port)]
 110         return $ AnnounceResp tid interval' 0 0 ipportpairs
 111       2 -> do
 112         tid <- fromIntegral <$> getWord32be
 113         _ <- getWord32be
 114         _ <- getWord32be
 115         _ <- getWord32be
 116         return $ ScrapeResp tid 0 0 0
 117       3 -> do -- error response
 118         tid <- fromIntegral <$> getWord32be
 119         bs  <- getByteString 4
 120         return $ ErrorResp tid $ unpack bs
 121       _ -> error ("unknown response action type: " ++ show a)
 122
 123 sendRequest :: UDPTrackerHandle -> UDPRequest -> IO ()
 124 sendRequest h req = do
 125   n <- sendTo (sock h) req (addr h)
 126   -- sanity check with n?
 127   return ()
 128
 129 recvResponse :: UDPTrackerHandle -> ErrorT String IO UDPResponse
 130 recvResponse h = do
 131   (bs, nbytes, saddr) <- recvFrom (sock h) 20
 132   -- check if nbytes is at least 16 bytes long
 133   return $ decode $ fromStrict bs
 134
 135 connectRequest :: ReaderT UDPTrackerHandle IO Integer
 136 connectRequest = do
 137   h <- ask
 138   let pkt = encode $ ConnectReq (tid h)
 139   sendRequest h pkt
 140
 141 connectResponse :: ReaderT UDPTrackerHandle IO Bool
 142 connectResponse = do
 143   h <- ask
 144
 145
 146 getIPPortPairs :: Get [(IP, Port)]
 147 getIPPortPairs = do
 148   empty <- isEmpty
 149   if empty
 150     then return []
 151     else do
 152     ip <- toIP <$> getByteString 6
 153     port <- toPort <$> getByteString 2
 154     ipportpairs <- getIPPortPairs
 155     return $ (ip, port) : ipportpairs
 156
 157 getResponse :: Socket -> IO UDPResponse
 158 getResponse s = do
 159   -- connect packet is 16 bytes long
 160   -- announce packet is atleast 20 bytes long
 161   bs <- recv s (16*1024)
 162   return $ decode $ fromStrict bs
 163
 164
 165 udpTrackerLoop :: PortNumber -> String -> Metainfo -> TState -> IO String
 166 udpTrackerLoop port peerId m st = do
 167   -- h <- connectTo "exodus.desync.com" (PortNumber 6969)
 168   s <- socket AF_INET Datagram defaultProtocol
 169   hostAddr <- inet_addr "185.37.101.229"
 170   putStrLn "connected to tracker"
 171   _ <- sendTo s (toStrict $ encode (ConnectReq 42)) (SockAddrInet 2710 hostAddr)
 172   putStrLn "--> sent ConnectReq to tracker"
 173   resp <- recv s 16
 174   putStrLn "<-- recv ConnectResp from tracker"
 175   return $ show resp