summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent/DHT
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/BitTorrent/DHT')
-rw-r--r--src/Network/BitTorrent/DHT/Message.hs509
-rw-r--r--src/Network/BitTorrent/DHT/Query.hs2
-rw-r--r--src/Network/BitTorrent/DHT/Session.hs2
-rw-r--r--src/Network/BitTorrent/DHT/Token.hs2
4 files changed, 3 insertions, 512 deletions
diff --git a/src/Network/BitTorrent/DHT/Message.hs b/src/Network/BitTorrent/DHT/Message.hs
deleted file mode 100644
index e21e0e70..00000000
--- a/src/Network/BitTorrent/DHT/Message.hs
+++ /dev/null
@@ -1,509 +0,0 @@
1-- |
2-- Copyright : (c) Sam Truzjan 2013
3-- License : BSD3
4-- Maintainer : pxqr.sta@gmail.com
5-- Stability : experimental
6-- Portability : portable
7--
8-- This module provides message datatypes which is used for /Node to
9-- Node/ communication. Bittorrent DHT is based on Kademlia
10-- specification, but have a slightly different set of messages
11-- which have been adopted for /peer/ discovery mechanism. Messages
12-- are sent over "Network.KRPC" protocol, but normally you should
13-- use "Network.BitTorrent.DHT.Session" to send and receive
14-- messages.
15--
16-- DHT queries are not /recursive/, they are /iterative/. This means
17-- that /querying/ node . While original specification (namely BEP5)
18-- do not impose any restrictions for /quered/ node behaviour, a
19-- good DHT implementation should follow some rules to guarantee
20-- that unlimit recursion will never happen. The following set of
21-- restrictions:
22--
23-- * 'Ping' query must not trigger any message.
24--
25-- * 'FindNode' query /may/ trigger 'Ping' query to check if a
26-- list of nodes to return is /good/. See
27-- 'Network.DHT.Routing.Routing' for further explanation.
28--
29-- * 'GetPeers' query may trigger 'Ping' query for the same reason.
30--
31-- * 'Announce' query must trigger 'Ping' query for the same reason.
32--
33-- It is easy to see that the most long RPC chain is:
34--
35-- @
36-- | | |
37-- Node_A | |
38-- | FindNode or GetPeers or Announce | |
39-- | ------------------------------------> Node_B |
40-- | | Ping |
41-- | | -----------> |
42-- | | Node_C
43-- | | Pong |
44-- | NodeFound or GotPeers or Announced | <----------- |
45-- | <------------------------------------- Node_B |
46-- Node_A | |
47-- | | |
48-- @
49--
50-- where in some cases 'Node_C' is 'Node_A'.
51--
52-- For more info see:
53-- <http://www.bittorrent.org/beps/bep_0005.html#dht-queries>
54--
55-- For Kamelia messages see original Kademlia paper:
56-- <http://pdos.csail.mit.edu/~petar/papers/maymounkov-kademlia-lncs.pdf>
57--
58{-# LANGUAGE CPP #-}
59{-# LANGUAGE DeriveDataTypeable #-}
60{-# LANGUAGE FlexibleInstances #-}
61{-# LANGUAGE MultiParamTypeClasses #-}
62{-# LANGUAGE UndecidableInstances #-}
63{-# LANGUAGE ScopedTypeVariables #-}
64{-# LANGUAGE TypeFamilies #-}
65module Network.BitTorrent.DHT.Message
66 ( -- * Envelopes
67 Query (..)
68 , Response (..)
69
70 -- * Queries
71 -- ** ping
72 , Ping (..)
73
74 -- ** find_node
75 , FindNode (..)
76 , NodeFound (..)
77 , bep42s
78 -- , bep42
79
80
81#ifdef VERSION_bencoding
82 -- ** get_peers
83 , PeerList
84 , GetPeers (..)
85 , GotPeers (..)
86
87 -- ** announce_peer
88 , Announce (..)
89 , Announced (..)
90#endif
91 ) where
92
93import Control.Applicative
94import Data.Bool
95#ifdef VERSION_bencoding
96import Data.BEncode as BE
97import Data.BEncode.BDict as BDict hiding (map)
98#else
99import qualified Network.DatagramServer.Tox as Tox
100import Network.DatagramServer.Tox (NodeId)
101import Data.Word
102import Control.Monad
103#endif
104import Network.KRPC.Method
105import Network.Address hiding (NodeId)
106import Data.Bits
107import Data.ByteString (ByteString)
108import qualified Data.ByteString as BS
109import Data.Digest.CRC32C
110import Data.List as L
111import Data.Monoid
112import Data.Serialize as S
113import Data.Typeable
114import Data.Word
115import Network
116import Network.DatagramServer
117import Network.DatagramServer.Mainline
118import Data.Maybe
119
120import Data.Torrent (InfoHash)
121import Network.BitTorrent.DHT.Token
122#ifdef VERSION_bencoding
123import Network.DatagramServer ()
124#endif
125import Network.DatagramServer.Types hiding (Query,Response)
126
127{-----------------------------------------------------------------------
128-- envelopes
129-----------------------------------------------------------------------}
130
131#ifndef VERSION_bencoding
132type BKey = ByteString
133#endif
134
135node_id_key :: BKey
136node_id_key = "id"
137
138read_only_key :: BKey
139read_only_key = "ro"
140
141
142#ifdef VERSION_bencoding
143-- | All queries have an \"id\" key and value containing the node ID
144-- of the querying node.
145data Query a = Query
146 { queringNodeId :: NodeId KMessageOf -- ^ node id of /quering/ node;
147 , queryIsReadOnly :: Bool -- ^ node is read-only as per BEP 43
148 , queryParams :: a -- ^ query parameters.
149 } deriving (Show, Eq, Typeable)
150
151instance BEncode a => BEncode (Query a) where
152 toBEncode Query {..} = toDict $
153 BDict.union ( node_id_key .=! queringNodeId
154 .: read_only_key .=? bool Nothing (Just (1 :: Integer)) queryIsReadOnly
155 .: endDict)
156 (dict (toBEncode queryParams))
157 where
158 dict (BDict d) = d
159 dict _ = error "impossible: instance BEncode (Query a)"
160
161 fromBEncode v = do
162 Query <$> fromDict (field (req node_id_key)) v
163 <*> fromDict (fromMaybe False <$>? read_only_key) v
164 <*> fromBEncode v
165#else
166data Query a = Query a
167#endif
168
169#ifdef VERSION_bencoding
170-- | All responses have an \"id\" key and value containing the node ID
171-- of the responding node.
172data Response a = Response
173 { queredNodeId :: NodeId KMessageOf -- ^ node id of /quered/ node;
174 , responseVals :: a -- ^ query result.
175 } deriving (Show, Eq, Typeable)
176
177instance BEncode a => BEncode (Response a) where
178 toBEncode = toBEncode . toQuery
179 where
180 toQuery (Response nid a) = Query nid False a
181
182 fromBEncode b = fromQuery <$> fromBEncode b
183 where
184 fromQuery (Query nid _ a) = Response nid a
185#else
186data Response a = Response a
187#endif
188
189{-----------------------------------------------------------------------
190-- ping method
191-----------------------------------------------------------------------}
192
193-- | The most basic query is a ping. Ping query is used to check if a
194-- quered node is still alive.
195#ifdef VERSION_bencoding
196data Ping = Ping
197#else
198data Ping = Ping Tox.Nonce8
199#endif
200 deriving (Show, Eq, Typeable)
201
202#ifdef VERSION_bencoding
203instance BEncode Ping where
204 toBEncode Ping = toDict endDict
205 fromBEncode _ = pure Ping
206#else
207instance Serialize (Query Ping) where
208 get = do
209 b <- get
210 when ( (b::Word8) /= 0) $ fail "Bad ping request"
211 nonce <- get
212 return $ Query (Ping nonce)
213 put (Query (Ping nonce)) = do
214 put (0 :: Word8)
215 put nonce
216instance Serialize (Response Ping) where
217 get = do
218 b <- get
219 when ( (b::Word8) /= 1) $ fail "Bad ping response"
220 nonce <- get
221 return $ Response (Ping nonce)
222 put (Response (Ping nonce)) = do
223 put (1 :: Word8)
224 put nonce
225#endif
226
227-- | \"q\" = \"ping\"
228instance KRPC (Query Ping) (Response Ping) where
229#ifdef VERSION_bencoding
230 type Envelope (Query Ping) (Response Ping) = BValue
231 seal = toBEncode
232 unseal = fromBEncode
233 method = "ping"
234#else
235 method = Method Tox.Ping -- response: Tox.Pong
236#endif
237
238{-----------------------------------------------------------------------
239-- find_node method
240-----------------------------------------------------------------------}
241
242-- | Find node is used to find the contact information for a node
243-- given its ID.
244#ifdef VERSION_bencoding
245newtype FindNode ip = FindNode (NodeId KMessageOf)
246#else
247data FindNode ip = FindNode (NodeId Tox.Message) Tox.Nonce8 -- Tox: Get Nodes
248#endif
249 deriving (Show, Eq, Typeable)
250
251target_key :: BKey
252target_key = "target"
253
254#ifdef VERSION_bencoding
255instance Typeable ip => BEncode (FindNode ip) where
256 toBEncode (FindNode nid) = toDict $ target_key .=! nid .: endDict
257 fromBEncode = fromDict $ FindNode <$>! target_key
258#else
259instance Serialize (Query (FindNode ip)) where
260 get = do
261 nid <- get
262 nonce <- get
263 return $ Query (FindNode nid nonce)
264 put (Query (FindNode nid nonce)) = do
265 put nid
266 put nonce
267#endif
268
269-- | When a node receives a 'FindNode' query, it should respond with a
270-- the compact node info for the target node or the K (8) closest good
271-- nodes in its own routing table.
272--
273#ifdef VERSION_bencoding
274newtype NodeFound ip = NodeFound [NodeInfo KMessageOf ip ()]
275#else
276data NodeFound ip = NodeFound [Tox.NodeFormat] Tox.Nonce8
277#endif
278-- Tox: send_nodes
279 deriving (Show, Eq, Typeable)
280
281nodes_key :: BKey
282nodes_key = "nodes"
283
284-- Convert IPv4 address. Useful for using variadic IP type.
285from4 :: forall dht u s. Address s => NodeInfo dht IPv4 u -> Either String (NodeInfo dht s u)
286from4 n = maybe (Left "Error converting IPv4") Right
287 $ traverseAddress (fromAddr :: IPv4 -> Maybe s) n
288
289#ifdef VERSION_bencoding
290binary :: Serialize a => BKey -> BE.Get [a]
291binary k = field (req k) >>= either (fail . format) return .
292 runGet (many get)
293 where
294 format str = "fail to deserialize " ++ show k ++ " field: " ++ str
295
296instance Address ip => BEncode (NodeFound ip) where
297 toBEncode (NodeFound ns) = toDict $
298 nodes_key .=! runPut (mapM_ put ns)
299 .: endDict
300
301 -- TODO: handle IPv6 by reading the "nodes6" key (see bep 32)
302 fromBEncode bval = NodeFound <$> (traverse from4 =<< fromDict (binary nodes_key) bval)
303#else
304instance Serialize (Response (NodeFound ip)) where
305 get = do
306 count <- get :: Get Word8
307 nodes <- sequence $ replicate (fromIntegral count) get
308 nonce <- get :: Get Tox.Nonce8
309 return $ Response $ NodeFound nodes nonce
310
311 put (Response (NodeFound nodes nonce)) = do
312 put (fromIntegral (length nodes) :: Word8)
313 mapM_ put nodes
314 put nonce
315
316#endif
317
318-- | \"q\" == \"find_node\"
319instance (Address ip, Typeable ip)
320 => KRPC (Query (FindNode ip)) (Response (NodeFound ip)) where
321#ifdef VERSION_bencoding
322 type Envelope (Query (FindNode ip)) (Response (NodeFound ip)) = BValue
323 seal = toBEncode
324 unseal = fromBEncode
325 method = "find_node"
326#else
327 method = Method Tox.GetNodes -- response: Tox.SendNodes
328#endif
329
330#ifdef VERSION_bencoding
331{-----------------------------------------------------------------------
332-- get_peers method
333-----------------------------------------------------------------------}
334
335-- | Get peers associated with a torrent infohash.
336newtype GetPeers ip = GetPeers InfoHash
337 deriving (Show, Eq, Typeable)
338
339info_hash_key :: BKey
340info_hash_key = "info_hash"
341
342instance Typeable ip => BEncode (GetPeers ip) where
343 toBEncode (GetPeers ih) = toDict $ info_hash_key .=! ih .: endDict
344 fromBEncode = fromDict $ GetPeers <$>! info_hash_key
345
346type PeerList ip = Either [NodeInfo KMessageOf ip ()] [PeerAddr ip]
347
348data GotPeers ip = GotPeers
349 { -- | If the queried node has no peers for the infohash, returned
350 -- the K nodes in the queried nodes routing table closest to the
351 -- infohash supplied in the query.
352 peers :: PeerList ip
353
354 -- | The token value is a required argument for a future
355 -- announce_peer query.
356 , grantedToken :: Token
357 } deriving (Show, Eq, Typeable)
358
359peers_key :: BKey
360peers_key = "values"
361
362token_key :: BKey
363token_key = "token"
364
365name_key :: BKey
366name_key = "name"
367
368instance (Typeable ip, Serialize ip) => BEncode (GotPeers ip) where
369 toBEncode GotPeers {..} = toDict $
370 case peers of
371 Left ns ->
372 nodes_key .=! runPut (mapM_ put ns)
373 .: token_key .=! grantedToken
374 .: endDict
375 Right ps ->
376 token_key .=! grantedToken
377 .: peers_key .=! L.map S.encode ps
378 .: endDict
379
380 fromBEncode = fromDict $ do
381 mns <- optional (binary nodes_key) -- "nodes"
382 tok <- field (req token_key) -- "token"
383 mps <- optional (field (req peers_key) >>= decodePeers) -- "values"
384 case (Right <$> mps) <|> (Left <$> mns) of
385 Nothing -> fail "get_peers: neihter peers nor nodes key is valid"
386 Just xs -> pure $ GotPeers xs tok
387 where
388 decodePeers = either fail pure . mapM S.decode
389
390-- | \"q" = \"get_peers\"
391instance (Typeable ip, Serialize ip) =>
392 KRPC (Query (GetPeers ip)) (Response (GotPeers ip)) where
393 type Envelope (Query (GetPeers ip)) (Response (GotPeers ip)) = BValue
394 seal = toBEncode
395 unseal = fromBEncode
396 method = "get_peers"
397
398{-----------------------------------------------------------------------
399-- announce method
400-----------------------------------------------------------------------}
401
402-- | Announce that the peer, controlling the querying node, is
403-- downloading a torrent on a port.
404data Announce = Announce
405 { -- | If set, the 'port' field should be ignored and the source
406 -- port of the UDP packet should be used as the peer's port
407 -- instead. This is useful for peers behind a NAT that may not
408 -- know their external port, and supporting uTP, they accept
409 -- incoming connections on the same port as the DHT port.
410 impliedPort :: Bool
411
412 -- | infohash of the torrent;
413 , topic :: InfoHash
414
415 -- | some clients announce the friendly name of the torrent here.
416 , announcedName :: Maybe ByteString
417
418 -- | the port /this/ peer is listening;
419 , port :: PortNumber
420
421 -- TODO: optional boolean "seed" key
422
423 -- | received in response to a previous get_peers query.
424 , sessionToken :: Token
425
426 } deriving (Show, Eq, Typeable)
427
428port_key :: BKey
429port_key = "port"
430
431implied_port_key :: BKey
432implied_port_key = "implied_port"
433
434instance BEncode Announce where
435 toBEncode Announce {..} = toDict $
436 implied_port_key .=? flagField impliedPort
437 .: info_hash_key .=! topic
438 .: name_key .=? announcedName
439 .: port_key .=! port
440 .: token_key .=! sessionToken
441 .: endDict
442 where
443 flagField flag = if flag then Just (1 :: Int) else Nothing
444
445 fromBEncode = fromDict $ do
446 Announce <$> (boolField <$> optional (field (req implied_port_key)))
447 <*>! info_hash_key
448 <*>? name_key
449 <*>! port_key
450 <*>! token_key
451 where
452 boolField = maybe False (/= (0 :: Int))
453
454-- | The queried node must verify that the token was previously sent
455-- to the same IP address as the querying node. Then the queried node
456-- should store the IP address of the querying node and the supplied
457-- port number under the infohash in its store of peer contact
458-- information.
459data Announced = Announced
460 deriving (Show, Eq, Typeable)
461
462instance BEncode Announced where
463 toBEncode _ = toBEncode Ping
464 fromBEncode _ = pure Announced
465
466-- | \"q" = \"announce\"
467instance KRPC (Query Announce) (Response Announced) where
468 type Envelope (Query Announce) (Response Announced) = BValue
469 seal = toBEncode
470 unseal = fromBEncode
471 method = "announce_peer"
472
473-- endif VERSION_bencoding
474#endif
475
476-- | Yields all 8 DHT neighborhoods available to you given a particular ip
477-- address.
478bep42s :: Address a => a -> NodeId KMessageOf -> [NodeId KMessageOf]
479bep42s addr (NodeId r) = mapMaybe (bep42 addr) rs
480 where
481 rs = map (NodeId . change3bits r) [0..7]
482
483-- change3bits :: ByteString -> Word8 -> ByteString
484-- change3bits bs n = BS.snoc (BS.init bs) (BS.last bs .&. 0xF8 .|. n)
485
486change3bits :: (Num b, Bits b) => b -> b -> b
487change3bits bs n = (bs .&. complement 7) .|. n
488
489-- | Modifies a purely random 'NodeId' to one that is related to a given
490-- routable address in accordance with BEP 42.
491bep42 :: Address a => a -> NodeId KMessageOf -> Maybe (NodeId KMessageOf)
492bep42 addr (NodeId r)
493 | Just ip <- fmap S.encode (fromAddr addr :: Maybe IPv4)
494 <|> fmap S.encode (fromAddr addr :: Maybe IPv6)
495 = genBucketSample' retr (NodeId $ crc $ applyMask ip) (3,0x07,0)
496 | otherwise
497 = Nothing
498 where
499 ip4mask = "\x03\x0f\x3f\xff" :: ByteString
500 ip6mask = "\x01\x03\x07\x0f\x1f\x3f\x7f\xff" :: ByteString
501 nbhood_select = (fromIntegral r :: Word8) .&. 7
502 retr n = pure $ BS.drop (nodeIdSize - n) $ S.encode r
503 crc = flip shiftL (finiteBitSize (NodeId undefined) - 32) . fromIntegral . crc32c . BS.pack
504 applyMask ip = case BS.zipWith (.&.) msk ip of
505 (b:bs) -> (b .|. shiftL nbhood_select 5) : bs
506 bs -> bs
507 where msk | BS.length ip == 4 = ip4mask
508 | otherwise = ip6mask
509
diff --git a/src/Network/BitTorrent/DHT/Query.hs b/src/Network/BitTorrent/DHT/Query.hs
index edc238e6..ae072db0 100644
--- a/src/Network/BitTorrent/DHT/Query.hs
+++ b/src/Network/BitTorrent/DHT/Query.hs
@@ -86,7 +86,7 @@ import Network.KRPC.Method as KRPC
86import Network.DatagramServer.Mainline (ReflectedIP(..)) 86import Network.DatagramServer.Mainline (ReflectedIP(..))
87import Network.DatagramServer (QueryFailure(..)) 87import Network.DatagramServer (QueryFailure(..))
88import Data.Torrent 88import Data.Torrent
89import Network.BitTorrent.DHT.Message 89import Network.DHT.Mainline
90import Network.DHT.Routing as R 90import Network.DHT.Routing as R
91import Network.BitTorrent.DHT.Session 91import Network.BitTorrent.DHT.Session
92import Control.Concurrent.STM 92import Control.Concurrent.STM
diff --git a/src/Network/BitTorrent/DHT/Session.hs b/src/Network/BitTorrent/DHT/Session.hs
index e205add4..2d290a95 100644
--- a/src/Network/BitTorrent/DHT/Session.hs
+++ b/src/Network/BitTorrent/DHT/Session.hs
@@ -116,7 +116,7 @@ import Network.DatagramServer.Tox as Tox
116import Network.Address 116import Network.Address
117import Network.BitTorrent.DHT.ContactInfo (PeerStore) 117import Network.BitTorrent.DHT.ContactInfo (PeerStore)
118import qualified Network.BitTorrent.DHT.ContactInfo as P 118import qualified Network.BitTorrent.DHT.ContactInfo as P
119import Network.BitTorrent.DHT.Message 119import Network.DHT.Mainline
120import Network.DHT.Routing as R 120import Network.DHT.Routing as R
121import Network.BitTorrent.DHT.Token as T 121import Network.BitTorrent.DHT.Token as T
122 122
diff --git a/src/Network/BitTorrent/DHT/Token.hs b/src/Network/BitTorrent/DHT/Token.hs
index 75eadd1a..e3a6b1f6 100644
--- a/src/Network/BitTorrent/DHT/Token.hs
+++ b/src/Network/BitTorrent/DHT/Token.hs
@@ -109,7 +109,7 @@ lookup addr TokenMap {..} = makeToken addr curSecret
109 109
110-- | Check if token is valid. 110-- | Check if token is valid.
111-- 111--
112-- Typically used to handle 'Network.BitTorrent.DHT.Message.Announce' 112-- Typically used to handle 'Network.DHT.Mainline.Announce'
113-- query. If token is invalid the 'Network.KRPC.ProtocolError' should 113-- query. If token is invalid the 'Network.KRPC.ProtocolError' should
114-- be sent back to the malicious node. 114-- be sent back to the malicious node.
115member :: Hashable a => NodeAddr a -> Token -> TokenMap -> Bool 115member :: Hashable a => NodeAddr a -> Token -> TokenMap -> Bool
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 19:38:56 +0000