From a4f06256fef2635f8ae953df61b5c3d725233f9c Mon Sep 17 00:00:00 2001 From: notogawa Date: Sat, 10 Nov 2012 01:02:50 +0900 Subject: [PATCH] accept SSLv2 format 'ClientHello' Handshake message. --- core/Network/TLS/Handshake/Client.hs | 2 +- core/Network/TLS/Handshake/Server.hs | 2 +- core/Network/TLS/IO.hs | 17 ++++++++-- core/Network/TLS/Packet.hs | 46 ++++++++++++++++++++++++++-- core/Network/TLS/Receiving.hs | 9 ++++-- core/Network/TLS/Struct.hs | 14 ++++++--- core/Tests.hs | 1 + 7 files changed, 77 insertions(+), 14 deletions(-) diff --git a/core/Network/TLS/Handshake/Client.hs b/core/Network/TLS/Handshake/Client.hs index 6857b7f..3b1ed28 100644 --- a/core/Network/TLS/Handshake/Client.hs +++ b/core/Network/TLS/Handshake/Client.hs @@ -77,7 +77,7 @@ handshakeClient cparams ctx = do usingState_ ctx (startHandshakeClient (pConnectVersion params) crand) sendPacket ctx $ Handshake [ ClientHello (pConnectVersion params) crand clientSession (map cipherID ciphers) - (map compressionID compressions) extensions + (map compressionID compressions) extensions Nothing ] return $ map fst extensions diff --git a/core/Network/TLS/Handshake/Server.hs b/core/Network/TLS/Handshake/Server.hs index fa62c94..96db753 100644 --- a/core/Network/TLS/Handshake/Server.hs +++ b/core/Network/TLS/Handshake/Server.hs @@ -77,7 +77,7 @@ handshakeServer sparams ctx = do -- -> finish <- finish -- handshakeServerWith :: MonadIO m => ServerParams -> Context -> Handshake -> m () -handshakeServerWith sparams ctx clientHello@(ClientHello ver _ clientSession ciphers compressions exts) = do +handshakeServerWith sparams ctx clientHello@(ClientHello ver _ clientSession ciphers compressions exts _) = do -- check if policy allow this new handshake to happens handshakeAuthorized <- withMeasure ctx (onHandshake $ ctxParams ctx) unless handshakeAuthorized (throwCore $ Error_HandshakePolicy "server: handshake denied") diff --git a/core/Network/TLS/IO.hs b/core/Network/TLS/IO.hs index d8066eb..a9aff37 100644 --- a/core/Network/TLS/IO.hs +++ b/core/Network/TLS/IO.hs @@ -51,14 +51,27 @@ readExact ctx sz = do return hdrbs recvRecord :: MonadIO m => Context -> m (Either TLSError (Record Plaintext)) -recvRecord ctx = readExact ctx 5 >>= either (return . Left) recvLength . decodeHeader +recvRecord ctx = do + header <- readExact ctx 2 + if B.head header < 0x80 + then readExact ctx 3 >>= either (return . Left) recvLength . decodeHeader . B.append header + else either (return . Left) recvDeprecatedLength $ decodeDeprecatedHeaderLength header where recvLength header@(Header _ _ readlen) - | readlen > 16384 + 2048 = return $ Left $ Error_Protocol ("record exceeding maximum size", True, RecordOverflow) + | readlen > 16384 + 2048 = return $ Left maximumSizeExceeded + | otherwise = readExact ctx (fromIntegral readlen) >>= makeRecord ctx header + recvDeprecatedLength readlen + | readlen > 1024 * 4 = return $ Left maximumSizeExceeded | otherwise = do content <- readExact ctx (fromIntegral readlen) + case decodeDeprecatedHeader readlen content of + Left err -> return $ Left err + Right header -> makeRecord ctx header content + maximumSizeExceeded = Error_Protocol ("record exceeding maximum size", True, RecordOverflow) + makeRecord ctx header content = do liftIO $ (loggingIORecv $ ctxLogging ctx) header content usingState ctx $ disengageRecord $ rawToRecord header (fragmentCiphertext content) + -- | receive one packet from the context that contains 1 or -- many messages (many only in case of handshake). if will returns a -- TLSError if the packet is unexpected or malformed diff --git a/core/Network/TLS/Packet.hs b/core/Network/TLS/Packet.hs index 7a2b40e..92dc778 100644 --- a/core/Network/TLS/Packet.hs +++ b/core/Network/TLS/Packet.hs @@ -15,6 +15,8 @@ module Network.TLS.Packet CurrentParams(..) -- * marshall functions for header messages , decodeHeader + , decodeDeprecatedHeaderLength + , decodeDeprecatedHeader , encodeHeader , encodeHeaderNoVer -- use for SSL3 @@ -26,6 +28,7 @@ module Network.TLS.Packet -- * marshall functions for handshake messages , decodeHandshakes , decodeHandshake + , decodeDeprecatedHandshake , encodeHandshake , encodeHandshakes , encodeHandshakeHeader @@ -52,6 +55,7 @@ import Network.TLS.Wire import Network.TLS.Cap import Data.Either (partitionEithers) import Data.Maybe (fromJust) +import Data.Word import Data.Bits ((.|.)) import Control.Applicative ((<$>)) import Control.Monad @@ -109,6 +113,16 @@ getHandshakeType = do decodeHeader :: ByteString -> Either TLSError Header decodeHeader = runGetErr "header" $ liftM3 Header getHeaderType getVersion getWord16 +decodeDeprecatedHeaderLength :: ByteString -> Either TLSError Word16 +decodeDeprecatedHeaderLength = runGetErr "deprecatedheaderlength" $ subtract 0x8000 <$> getWord16 + +decodeDeprecatedHeader :: Word16 -> ByteString -> Either TLSError Header +decodeDeprecatedHeader size = + runGetErr "deprecatedheader" $ do + 1 <- getWord8 + version <- getVersion + return $ Header ProtocolType_DeprecatedHandshake version size + encodeHeader :: Header -> ByteString encodeHeader (Header pt ver len) = runPut (putHeaderType pt >> putVersion ver >> putWord16 len) {- FIXME check len <= 2^14 -} @@ -173,6 +187,28 @@ decodeHandshake cp ty = runGetErr "handshake" $ case ty of unless (cParamsSupportNPN cp) $ fail "unsupported handshake type" decodeNextProtocolNegotiation +decodeDeprecatedHandshake :: ByteString -> Either TLSError Handshake +decodeDeprecatedHandshake b = runGetErr "deprecatedhandshake" getDeprecated b where + getDeprecated = do + 1 <- getWord8 + ver <- getVersion + cipherSpecLen <- fromEnum <$> getWord16 + sessionIdLen <- fromEnum <$> getWord16 + challengeLen <- fromEnum <$> getWord16 + ciphers <- getCipherSpec cipherSpecLen + session <- getSessionId sessionIdLen + random <- getChallenge challengeLen + let compressions = [0] + return $ ClientHello ver random session ciphers compressions [] (Just b) + getCipherSpec len | len < 3 = return [] + getCipherSpec len = do + [c0,c1,c2] <- map fromEnum <$> replicateM 3 getWord8 + ([ toEnum $ c1 * 0x100 + c2 | c0 == 0 ] ++) <$> getCipherSpec (len - 3) + getSessionId 0 = return $ Session Nothing + getSessionId len = Session . Just <$> getBytes len + getChallenge len | 32 < len = getBytes (len - 32) >> getChallenge 32 + getChallenge len = ClientRandom . B.append (B.replicate (32 - len) 0) <$> getBytes len + decodeHelloRequest :: Get Handshake decodeHelloRequest = return HelloRequest @@ -187,7 +223,7 @@ decodeClientHello = do exts <- if hasHelloExtensions ver && r > 0 then fmap fromIntegral getWord16 >>= getExtensions else return [] - return $ ClientHello ver random session ciphers compressions exts + return $ ClientHello ver random session ciphers compressions exts Nothing decodeServerHello :: Get Handshake decodeServerHello = do @@ -300,7 +336,9 @@ encodeHandshake :: Handshake -> ByteString encodeHandshake o = let content = runPut $ encodeHandshakeContent o in let len = fromIntegral $ B.length content in - let header = runPut $ encodeHandshakeHeader (typeOfHandshake o) len in + let header = case o of + ClientHello _ _ _ _ _ _ (Just _) -> "" -- SSLv2 ClientHello message + _ -> runPut $ encodeHandshakeHeader (typeOfHandshake o) len in B.concat [ header, content ] encodeHandshakes :: [Handshake] -> ByteString @@ -311,7 +349,9 @@ encodeHandshakeHeader ty len = putWord8 (valOfType ty) >> putWord24 len encodeHandshakeContent :: Handshake -> Put -encodeHandshakeContent (ClientHello version random session cipherIDs compressionIDs exts) = do +encodeHandshakeContent (ClientHello _ _ _ _ _ _ (Just deprecated)) = do + putBytes deprecated +encodeHandshakeContent (ClientHello version random session cipherIDs compressionIDs exts Nothing) = do putVersion version putClientRandom32 random putSession session diff --git a/core/Network/TLS/Receiving.hs b/core/Network/TLS/Receiving.hs index bd64923..ca21467 100644 --- a/core/Network/TLS/Receiving.hs +++ b/core/Network/TLS/Receiving.hs @@ -58,11 +58,16 @@ processPacket (Record ProtocolType_Handshake ver fragment) = do Right hs -> return hs return $ Handshake hss +processPacket (Record ProtocolType_DeprecatedHandshake _ fragment) = + case decodeDeprecatedHandshake $ fragmentGetBytes fragment of + Left err -> throwError err + Right hs -> return $ Handshake [hs] + processHandshake :: Handshake -> TLSSt () processHandshake hs = do clientmode <- isClientContext case hs of - ClientHello cver ran _ _ _ ex -> unless clientmode $ do + ClientHello cver ran _ _ _ ex _ -> unless clientmode $ do mapM_ processClientExtension ex startHandshakeClient cver ran Certificates certs -> processCertificates clientmode certs @@ -143,7 +148,7 @@ processClientFinished fdata = do processCertificates :: Bool -> [X509] -> TLSSt () processCertificates clientmode certs = do - if null certs + if null certs then when (clientmode) $ throwError $ Error_Protocol ("server certificate missing", True, HandshakeFailure) diff --git a/core/Network/TLS/Struct.hs b/core/Network/TLS/Struct.hs index 1a58218..13a0941 100644 --- a/core/Network/TLS/Struct.hs +++ b/core/Network/TLS/Struct.hs @@ -108,6 +108,7 @@ data ProtocolType = | ProtocolType_Alert | ProtocolType_Handshake | ProtocolType_AppData + | ProtocolType_DeprecatedHandshake deriving (Eq, Show) -- | TLSError that might be returned through the TLS stack @@ -233,8 +234,10 @@ data ServerKeyXchgAlgorithmData = | SKX_Unknown Bytes deriving (Show,Eq) +type DeprecatedRecord = ByteString + data Handshake = - ClientHello !Version !ClientRandom !Session ![CipherID] ![CompressionID] [ExtensionRaw] + ClientHello !Version !ClientRandom !Session ![CipherID] ![CompressionID] [ExtensionRaw] (Maybe DeprecatedRecord) | ServerHello !Version !ServerRandom !Session !CipherID !CompressionID [ExtensionRaw] | Certificates [X509] | HelloRequest @@ -304,10 +307,11 @@ instance TypeValuable CipherType where valToType _ = Nothing instance TypeValuable ProtocolType where - valOfType ProtocolType_ChangeCipherSpec = 20 - valOfType ProtocolType_Alert = 21 - valOfType ProtocolType_Handshake = 22 - valOfType ProtocolType_AppData = 23 + valOfType ProtocolType_ChangeCipherSpec = 20 + valOfType ProtocolType_Alert = 21 + valOfType ProtocolType_Handshake = 22 + valOfType ProtocolType_AppData = 23 + valOfType ProtocolType_DeprecatedHandshake = 128 -- unused valToType 20 = Just ProtocolType_ChangeCipherSpec valToType 21 = Just ProtocolType_Alert diff --git a/core/Tests.hs b/core/Tests.hs index 70da576..936016c 100644 --- a/core/Tests.hs +++ b/core/Tests.hs @@ -93,6 +93,7 @@ instance Arbitrary Handshake where <*> arbitraryCiphersIDs <*> arbitraryCompressionIDs <*> (return []) + <*> (return Nothing) , ServerHello <$> arbitrary <*> arbitrary