2 - Copyright (C) 2015-2016 Ramakrishnan Muthukrishnan <ram@rkrishnan.org>
4 - This file is part of FuncTorrent.
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.
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.
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/>
20 {-# LANGUAGE OverloadedStrings #-}
21 module FuncTorrent.Tracker.Udp
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)
38 import FuncTorrent.Tracker.Types (TrackerEventState(..))
39 import FuncTorrent.Utils (IP, Port, toIP, toPort)
41 -- UDP tracker: http://bittorrent.org/beps/bep_0015.html
47 data UDPRequest = ConnectReq Word32
48 | AnnounceReq Integer Integer ByteString String Integer Integer Integer TrackerEventState Integer
49 | ScrapeReq Integer Integer ByteString
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
58 data UDPTrackerHandle = UDPTrackerHandle { sock :: Socket
63 actionToInteger :: Action -> Integer
64 actionToInteger Connect = 0
65 actionToInteger Announce = 1
66 actionToInteger Scrape = 2
68 intToAction :: Integer -> Action
69 intToAction 0 = Connect
70 intToAction 1 = Announce
71 intToAction 2 = Scrape
73 eventToInteger :: TrackerEventState -> Integer
74 eventToInteger None = 0
75 eventToInteger Completed = 1
76 eventToInteger Started = 2
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)
94 -- key is optional, we will not send it for now
95 putWord32be $ fromIntegral (-1)
96 putWord16be $ fromIntegral port
97 put (ScrapeReq _ _ _) = undefined
100 instance Binary UDPResponse where
103 a <- getWord32be -- action
105 0 -> liftA2 ConnectResp (fromIntegral <$> getWord32be) (fromIntegral <$> getWord32be)
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
114 tid <- fromIntegral <$> 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)
125 sendRequest :: UDPTrackerHandle -> ByteString -> IO ()
126 sendRequest h req = do
127 n <- sendTo (sock h) req (addr h)
128 -- sanity check with n?
131 recvResponse :: UDPTrackerHandle -> IO UDPResponse
133 (bs, saddr) <- recvFrom (sock h) 32
134 return $ decode $ fromStrict bs
136 connectRequest :: ReaderT UDPTrackerHandle IO ()
139 let pkt = encode $ ConnectReq (tid h)
140 liftIO $ sendRequest h (toStrict pkt)
142 connectResponse :: Word32 -> ReaderT UDPTrackerHandle IO Bool
143 connectResponse itid = do
145 resp <- liftIO $ recvResponse h
146 -- check if nbytes is at least 16 bytes long
148 (ConnectResp tid cid) -> return $ tid == itid
151 getIPPortPairs :: Get [(IP, Port)]
157 ip <- toIP <$> getByteString 6
158 port <- toPort <$> getByteString 2
159 ipportpairs <- getIPPortPairs
160 return $ (ip, port) : ipportpairs
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"
168 return $ UDPTrackerHandle { sock = s
170 , addr = (SockAddrInet (fromIntegral port) hostAddr) }
172 closeSession :: UDPTrackerHandle -> IO ()
173 closeSession (UDPTrackerHandle s _ _) = close s