take in account that we can receive multiple handshakes in the same tls fragment.
This commit is contained in:
parent
8049ad6c6f
commit
5a6ff3abe8
3 changed files with 23 additions and 9 deletions
|
@ -20,7 +20,7 @@ module Network.TLS.Packet
|
|||
, encodeAlert
|
||||
|
||||
-- * marshall functions for handshake messages
|
||||
, decodeHandshakeHeader
|
||||
, decodeHandshakes
|
||||
, decodeHandshake
|
||||
, encodeHandshake
|
||||
, encodeHandshakeHeader
|
||||
|
@ -90,19 +90,26 @@ encodeAlert :: (AlertLevel, AlertDescription) -> ByteString
|
|||
encodeAlert (al, ad) = runPut (putWord8 (valOfType al) >> putWord8 (valOfType ad))
|
||||
|
||||
{- decode and encode HANDSHAKE -}
|
||||
|
||||
decodeHandshakeHeader :: ByteString -> Either TLSError (HandshakeType, Bytes)
|
||||
decodeHandshakeHeader = runGet $ do
|
||||
decodeHandshakeHeader :: Get (HandshakeType, Bytes)
|
||||
decodeHandshakeHeader = do
|
||||
tyopt <- getWord8 >>= return . valToType
|
||||
ty <- if isNothing tyopt
|
||||
then throwError (Error_Unknown_Type "handshake type")
|
||||
else return $ fromJust tyopt
|
||||
len <- getWord24
|
||||
content <- getBytes len
|
||||
empty <- isEmpty
|
||||
unless empty (throwError (Error_Internal_Packet_Remaining 1))
|
||||
return (ty, content)
|
||||
|
||||
decodeHandshakes :: ByteString -> Either TLSError [(HandshakeType, Bytes)]
|
||||
decodeHandshakes b = runGet getAll b
|
||||
where
|
||||
getAll = do
|
||||
x <- decodeHandshakeHeader
|
||||
empty <- isEmpty
|
||||
if empty
|
||||
then return [x]
|
||||
else getAll >>= \l -> return (x : l)
|
||||
|
||||
decodeHandshake :: Version -> HandshakeType -> ByteString -> Either TLSError Handshake
|
||||
decodeHandshake ver ty = runGet $ case ty of
|
||||
HandshakeType_HelloRequest -> decodeHelloRequest
|
||||
|
|
|
@ -69,7 +69,15 @@ processPacket (Header ProtocolType_ChangeCipherSpec _ _) content = do
|
|||
return ChangeCipherSpec
|
||||
|
||||
processPacket (Header ProtocolType_Handshake ver _) dcontent = do
|
||||
(ty, econtent) <- returnEither $ decodeHandshakeHeader dcontent
|
||||
handshakes <- returnEither (decodeHandshakes dcontent)
|
||||
hss <- forM handshakes $ \(ty, content) -> do
|
||||
hs <- processHandshake ver ty content
|
||||
when (finishHandshakeTypeMaterial ty) $ updateHandshakeDigestSplitted ty content
|
||||
return hs
|
||||
return $ head hss -- FIXME for compat until we fixes the expectations in server/client
|
||||
|
||||
processHandshake :: Version -> HandshakeType -> ByteString -> TLSRead Packet
|
||||
processHandshake ver ty econtent = do
|
||||
-- SECURITY FIXME if RSA fail, we need to generate a random master secret and not fail.
|
||||
content <- case ty of
|
||||
HandshakeType_ClientKeyXchg -> do
|
||||
|
@ -93,7 +101,6 @@ processPacket (Header ProtocolType_Handshake ver _) dcontent = do
|
|||
processClientKeyXchg cver content
|
||||
Finished fdata -> processClientFinished fdata
|
||||
_ -> return ()
|
||||
when (finishHandshakeTypeMaterial ty) (updateHandshakeDigest dcontent)
|
||||
return $ Handshake hs
|
||||
|
||||
decryptRSA :: MonadTLSState m => ByteString -> m (Maybe ByteString)
|
||||
|
|
2
Tests.hs
2
Tests.hs
|
@ -89,7 +89,7 @@ instance Arbitrary Handshake where
|
|||
prop_header_marshalling_id x = (decodeHeader $ encodeHeader x) == Right x
|
||||
prop_handshake_marshalling_id x = (decodeHs $ encodeHandshake x) == Right x
|
||||
where
|
||||
decodeHs b = either (Left . id) (\(ty, bdata) -> decodeHandshake TLS10 ty bdata) $ decodeHandshakeHeader b
|
||||
decodeHs b = either (Left . id) (uncurry (decodeHandshake TLS10) . head) $ decodeHandshakes b
|
||||
|
||||
{- main -}
|
||||
args = Args
|
||||
|
|
Loading…
Reference in a new issue