summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/BitTorrent')
-rw-r--r--src/Network/BitTorrent/Exchange/Wire.hs75
1 files changed, 75 insertions, 0 deletions
diff --git a/src/Network/BitTorrent/Exchange/Wire.hs b/src/Network/BitTorrent/Exchange/Wire.hs
index 239358d9..baf76e5f 100644
--- a/src/Network/BitTorrent/Exchange/Wire.hs
+++ b/src/Network/BitTorrent/Exchange/Wire.hs
@@ -26,6 +26,9 @@ module Network.BitTorrent.Exchange.Wire
26 , FlowStats (..) 26 , FlowStats (..)
27 , ConnectionStats (..) 27 , ConnectionStats (..)
28 28
29 -- ** Flood detection
30 , FloodDetector (..)
31
29 -- ** Connection 32 -- ** Connection
30 , Connection 33 , Connection
31 , connProtocol 34 , connProtocol
@@ -68,6 +71,7 @@ import Network.Socket
68import Network.Socket.ByteString as BS 71import Network.Socket.ByteString as BS
69import Text.PrettyPrint as PP hiding (($$), (<>)) 72import Text.PrettyPrint as PP hiding (($$), (<>))
70import Text.PrettyPrint.Class 73import Text.PrettyPrint.Class
74import Text.Show.Functions
71 75
72import Data.Torrent.InfoHash 76import Data.Torrent.InfoHash
73import Network.BitTorrent.Core 77import Network.BitTorrent.Core
@@ -170,6 +174,10 @@ data WireFailure
170 174
171 -- | See 'ProtocolError' for more details. 175 -- | See 'ProtocolError' for more details.
172 | ProtocolError ProtocolError 176 | ProtocolError ProtocolError
177
178 -- | A possible malicious peer have sent too many control messages
179 -- without making any progress.
180 | FloodDetected ConnectionStats
173 deriving (Show, Typeable) 181 deriving (Show, Typeable)
174 182
175instance Exception WireFailure 183instance Exception WireFailure
@@ -271,6 +279,73 @@ addStats :: ChannelSide -> ByteStats -> ConnectionStats -> ConnectionStats
271addStats ThisPeer x s = s { outcomingFlow = addFlowStats x (outcomingFlow s) } 279addStats ThisPeer x s = s { outcomingFlow = addFlowStats x (outcomingFlow s) }
272addStats RemotePeer x s = s { incomingFlow = addFlowStats x (incomingFlow s) } 280addStats RemotePeer x s = s { incomingFlow = addFlowStats x (incomingFlow s) }
273 281
282-- | Sum of overhead and control bytes in both directions.
283wastedBytes :: ConnectionStats -> Int
284wastedBytes ConnectionStats {..} = overhead + control
285 where
286 FlowStats _ ByteStats {..} = incomingFlow <> outcomingFlow
287
288-- | Sum of payload bytes in both directions.
289payloadBytes :: ConnectionStats -> Int
290payloadBytes ConnectionStats {..} =
291 payload (messageBytes (incomingFlow <> outcomingFlow))
292
293-- | Sum of any bytes in both directions.
294transmittedBytes :: ConnectionStats -> Int
295transmittedBytes ConnectionStats {..} =
296 byteLength (messageBytes (incomingFlow <> outcomingFlow))
297
298{-----------------------------------------------------------------------
299-- Flood protection
300-----------------------------------------------------------------------}
301
302defaultFloodFactor :: Int
303defaultFloodFactor = 1
304
305-- | This is a very permissive value, connection setup usually takes
306-- around 10-100KB, including both directions.
307defaultFloodThreshold :: Int
308defaultFloodThreshold = 2 * 1024 * 1024
309
310-- | A flood detection function.
311type Detector stats = Int -- ^ Factor;
312 -> Int -- ^ Threshold;
313 -> stats -- ^ Stats to analyse;
314 -> Bool -- ^ Is this a flooded connection?
315
316defaultDetector :: Detector ConnectionStats
317defaultDetector factor threshold s =
318 transmittedBytes s > threshold &&
319 factor * wastedBytes s > payloadBytes s
320
321-- | Flood detection is used to protect /this/ peer against a /remote/
322-- malicious peer sending meaningless control messages.
323data FloodDetector = FloodDetector
324 { -- | Max ratio of payload bytes to control bytes.
325 floodFactor :: {-# UNPACK #-} !Int
326
327 -- | Max count of bytes connection /setup/ can take including
328 -- 'Handshake', 'ExtendedHandshake', 'Bitfield', 'Have' and 'Port'
329 -- messages. This value is used to avoid false positives at the
330 -- connection initialization.
331 , floodThreshold :: {-# UNPACK #-} !Int
332
333 -- | Flood predicate on the /current/ 'ConnectionStats'.
334 , floodDetector :: Detector ConnectionStats
335 } deriving Show
336
337
338instance Default FloodDetector where
339 def = FloodDetector
340 { floodFactor = defaultFloodFactor
341 , floodThreshold = defaultFloodThreshold
342 , floodDetector = defaultDetector
343 }
344
345-- | This peer might drop connection if the detector gives positive answer.
346runDetector :: FloodDetector -> ConnectionStats -> Bool
347runDetector FloodDetector {..} = floodDetector floodFactor floodThreshold
348
274{----------------------------------------------------------------------- 349{-----------------------------------------------------------------------
275-- Connection 350-- Connection
276-----------------------------------------------------------------------} 351-----------------------------------------------------------------------}