From 2defefa35ba45ca773160c8c4b01c73c61fc3fc0 Mon Sep 17 00:00:00 2001 From: Sam Truzjan Date: Wed, 11 Dec 2013 02:12:08 +0400 Subject: Add protection against too long messages --- src/Network/BitTorrent/Exchange/Message.hs | 123 ++++++++++++++++++++++------- 1 file changed, 96 insertions(+), 27 deletions(-) diff --git a/src/Network/BitTorrent/Exchange/Message.hs b/src/Network/BitTorrent/Exchange/Message.hs index c3f6818f..3fe3f1bf 100644 --- a/src/Network/BitTorrent/Exchange/Message.hs +++ b/src/Network/BitTorrent/Exchange/Message.hs @@ -84,6 +84,7 @@ module Network.BitTorrent.Exchange.Message import Control.Applicative import Control.Arrow ((&&&), (***)) +import Control.Monad (when) import Data.Attoparsec.ByteString.Char8 as BS import Data.BEncode as BE import Data.BEncode.BDict as BE @@ -642,7 +643,7 @@ data ExtendedHandshake = ExtendedHandshake , ehsCaps :: ExtendedCaps -- | Size of 'Data.Torrent.InfoDict' in bytes. This field should - -- be added if ExtMetadata is enabled in current session /and/ + -- be added if 'ExtMetadata' is enabled in current session /and/ -- peer have the torrent file. , ehsMetadataSize :: Maybe Int @@ -757,7 +758,8 @@ data ExtendedMetadata -- factor. | MetadataReject PieceIx - -- | Reserved. + -- | Reserved. By specification we should ignore unknown metadata + -- messages. | MetadataUnknown BValue deriving (Show, Eq, Typeable) @@ -839,20 +841,40 @@ getMetadataPayload :: ExtendedMetadata -> Maybe BS.ByteString getMetadataPayload (MetadataData (Data.Piece _ bs) _) = Just bs getMetadataPayload _ = Nothing +-- | Metadata BDict usually contain only 'msg_type_key', 'piece_key' +-- and 'total_size_key' fields so it normally should take less than +-- 100 bytes. This limit is two order of magnitude larger to be +-- permissive to 'MetadataUnknown' messages. +-- +-- See 'maxMessageSize' for further explanation. +-- +maxMetadataBDictSize :: Int +maxMetadataBDictSize = 16 * 1024 + +maxMetadataSize :: Int +maxMetadataSize = maxMetadataBDictSize + metadataPieceSize + -- to make MetadataData constructor fields a little bit prettier we -- cheat here: first we read empty 'pieceData' from bdict, but then we -- fill that field with the actual piece data — trailing bytes of -- the message getMetadata :: Int -> S.Get ExtendedMetadata -getMetadata len = do - bs <- getByteString len - case BS.parse BE.parser bs of - BS.Fail _ _ _ -> fail "unable to parse metadata bdict: possible corrupted" - BS.Partial c -> fail "unable to parse metadata bdict: not enough bytes" - BS.Done piece bvalueBS -> do - let msg = "metadata dictionary is invalid" - metadata <- either (fail msg) pure $ fromBEncode bvalueBS - pure $ setMetadataPayload piece metadata +getMetadata len + | len > maxMetadataSize = fail $ parseError "size exceeded limit" + | otherwise = do + bs <- getByteString len + parseRes $ BS.parse BE.parser bs + where + parseError reason = "unable to parse metadata message: " ++ reason + + parseRes (BS.Fail _ _ _) = fail $ parseError "bdict: possible corrupted" + parseRes (BS.Partial c) = fail $ parseError "bdict: not enough bytes" + parseRes (BS.Done piece bvalueBS) + | BS.length piece > metadataPieceSize + = fail "infodict piece: size exceeded limit" + | otherwise = do + metadata <- either (fail . parseError) pure $ fromBEncode bvalueBS + return $ setMetadataPayload piece metadata putMetadata :: ExtendedMetadata -> BL.ByteString putMetadata msg @@ -972,9 +994,48 @@ putInt :: S.Putter Int putInt = S.putWord32be . fromIntegral {-# INLINE putInt #-} +-- | This limit should protect against "out-of-memory" attacks: if a +-- malicious peer have sent a long varlength message then receiver can +-- accumulate too long bytestring in the 'Get'. +-- +-- Normal messages should never exceed this limits. +-- +-- See also 'maxBitfieldSize', 'maxBlockSize' limits. +-- +maxMessageSize :: Int +maxMessageSize = 20 + 1024 * 1024 + +-- | This also limit max torrent size to: +-- +-- max_bitfield_size * piece_ix_per_byte * max_piece_size = +-- 2 ^ 20 * 8 * 1MB = +-- 8TB +-- +maxBitfieldSize :: Int +maxBitfieldSize = 1024 * 1024 + +getBitfield :: Int -> S.Get Bitfield +getBitfield len + | len > maxBitfieldSize = fail "BITFIELD message size exceeded limit" + | otherwise = fromBitmap <$> getByteString len + +maxBlockSize :: Int +maxBlockSize = 4 * defaultTransferSize + +getBlock :: Int -> S.Get (Block BL.ByteString) +getBlock len + | len > maxBlockSize = fail "BLOCK message size exceeded limit" + | otherwise = Block <$> getInt <*> getInt + <*> getLazyByteString (fromIntegral len) +{-# INLINE getBlock #-} + instance Serialize Message where get = do len <- getInt + + when (len > maxMessageSize) $ do + fail "message body size exceeded the limit" + if len == 0 then return KeepAlive else do mid <- S.getWord8 @@ -983,12 +1044,11 @@ instance Serialize Message where 0x01 -> return $ Status (Choking False) 0x02 -> return $ Status (Interested True) 0x03 -> return $ Status (Interested False) - 0x04 -> (Available . Have) <$> getInt - 0x05 -> (Available . Bitfield . fromBitmap) - <$> S.getByteString (pred len) - 0x06 -> (Transfer . Request) <$> S.get - 0x07 -> (Transfer . Piece) <$> getBlock (len - 9) - 0x08 -> (Transfer . Cancel) <$> S.get + 0x04 -> (Available . Have) <$> getInt + 0x05 -> (Available . Bitfield) <$> getBitfield (pred len) + 0x06 -> (Transfer . Request) <$> S.get + 0x07 -> (Transfer . Piece) <$> getBlock (len - 9) + 0x08 -> (Transfer . Cancel) <$> S.get 0x09 -> Port <$> S.get 0x0D -> (Fast . SuggestPiece) <$> getInt 0x0E -> return $ Fast HaveAll @@ -1001,12 +1061,6 @@ instance Serialize Message where fail $ "unknown message ID: " ++ show mid ++ "\n" ++ "remaining available bytes: " ++ show rm - where - getBlock :: Int -> S.Get (Block BL.ByteString) - getBlock len = Block <$> getInt <*> getInt - <*> S.getLazyByteString (fromIntegral len) - {-# INLINE getBlock #-} - put KeepAlive = putInt 0 put (Status msg) = putStatus msg put (Available msg) = putAvailable msg @@ -1061,10 +1115,24 @@ putFast (SuggestPiece pix) = putInt 5 >> putWord8 0x0D >> putInt pix putFast (RejectRequest i ) = putInt 13 >> putWord8 0x10 >> put i putFast (AllowedFast i ) = putInt 5 >> putWord8 0x11 >> putInt i +maxEHandshakeSize :: Int +maxEHandshakeSize = 16 * 1024 + getExtendedHandshake :: Int -> S.Get ExtendedHandshake -getExtendedHandshake messageSize = do - bs <- getByteString messageSize - either fail pure $ BE.decode bs +getExtendedHandshake messageSize + | messageSize > maxEHandshakeSize + = fail "extended handshake size exceeded limit" + | otherwise = do + bs <- getByteString messageSize + either fail pure $ BE.decode bs + +maxEUnknownSize :: Int +maxEUnknownSize = 64 * 1024 + +getExtendedUnknown :: Int -> S.Get BS.ByteString +getExtendedUnknown len + | len > maxEUnknownSize = fail "unknown extended message size exceeded limit" + | otherwise = getByteString len getExtendedMessage :: Int -> S.Get ExtendedMessage getExtendedMessage messageSize = do @@ -1073,8 +1141,9 @@ getExtendedMessage messageSize = do case msgId of 0 -> EHandshake <$> getExtendedHandshake msgBodySize 1 -> EMetadata msgId <$> getMetadata msgBodySize - _ -> EUnknown msgId <$> getByteString msgBodySize + _ -> EUnknown msgId <$> getExtendedUnknown msgBodySize +-- | By spec. extendedMessageId :: MessageId extendedMessageId = 20 -- cgit v1.2.3