1-- | 2-- Module : Network.TLS.Sending 3-- License : BSD-style 4-- Maintainer : Vincent Hanquez <vincent@snarc.org> 5-- Stability : experimental 6-- Portability : unknown 7-- 8-- the Sending module contains calls related to marshalling packets according 9-- to the TLS state 10-- 11module Network.TLS.Sending ( 12 encodePacket 13 , encodePacket13 14 , updateHandshake 15 , updateHandshake13 16 ) where 17 18import Network.TLS.Cipher 19import Network.TLS.Context.Internal 20import Network.TLS.Handshake.Random 21import Network.TLS.Handshake.State 22import Network.TLS.Handshake.State13 23import Network.TLS.Imports 24import Network.TLS.Packet 25import Network.TLS.Packet13 26import Network.TLS.Parameters 27import Network.TLS.Record 28import Network.TLS.Record.Layer 29import Network.TLS.State 30import Network.TLS.Struct 31import Network.TLS.Struct13 32import Network.TLS.Types (Role(..)) 33import Network.TLS.Util 34 35import Control.Concurrent.MVar 36import Control.Monad.State.Strict 37import qualified Data.ByteString as B 38import Data.IORef 39 40-- | encodePacket transform a packet into marshalled data related to current state 41-- and updating state on the go 42encodePacket :: Monoid bytes 43 => Context -> RecordLayer bytes -> Packet -> IO (Either TLSError bytes) 44encodePacket ctx recordLayer pkt = do 45 (ver, _) <- decideRecordVersion ctx 46 let pt = packetType pkt 47 mkRecord bs = Record pt ver (fragmentPlaintext bs) 48 len = ctxFragmentSize ctx 49 records <- map mkRecord <$> packetToFragments ctx len pkt 50 bs <- fmap mconcat <$> forEitherM records (recordEncode recordLayer) 51 when (pkt == ChangeCipherSpec) $ switchTxEncryption ctx 52 return bs 53 54-- Decompose handshake packets into fragments of the specified length. AppData 55-- packets are not fragmented here but by callers of sendPacket, so that the 56-- empty-packet countermeasure may be applied to each fragment independently. 57packetToFragments :: Context -> Maybe Int -> Packet -> IO [ByteString] 58packetToFragments ctx len (Handshake hss) = 59 getChunks len . B.concat <$> mapM (updateHandshake ctx ClientRole) hss 60packetToFragments _ _ (Alert a) = return [encodeAlerts a] 61packetToFragments _ _ ChangeCipherSpec = return [encodeChangeCipherSpec] 62packetToFragments _ _ (AppData x) = return [x] 63 64switchTxEncryption :: Context -> IO () 65switchTxEncryption ctx = do 66 tx <- usingHState ctx (fromJust "tx-state" <$> gets hstPendingTxState) 67 (ver, cc) <- usingState_ ctx $ do v <- getVersion 68 c <- isClientContext 69 return (v, c) 70 liftIO $ modifyMVar_ (ctxTxState ctx) (\_ -> return tx) 71 -- set empty packet counter measure if condition are met 72 when (ver <= TLS10 && cc == ClientRole && isCBC tx && supportedEmptyPacket (ctxSupported ctx)) $ liftIO $ writeIORef (ctxNeedEmptyPacket ctx) True 73 where isCBC tx = maybe False (\c -> bulkBlockSize (cipherBulk c) > 0) (stCipher tx) 74 75updateHandshake :: Context -> Role -> Handshake -> IO ByteString 76updateHandshake ctx role hs = do 77 case hs of 78 Finished fdata -> usingState_ ctx $ updateVerifiedData role fdata 79 _ -> return () 80 usingHState ctx $ do 81 when (certVerifyHandshakeMaterial hs) $ addHandshakeMessage encoded 82 when (finishHandshakeTypeMaterial $ typeOfHandshake hs) $ updateHandshakeDigest encoded 83 return encoded 84 where 85 encoded = encodeHandshake hs 86 87---------------------------------------------------------------- 88 89encodePacket13 :: Monoid bytes 90 => Context -> RecordLayer bytes -> Packet13 -> IO (Either TLSError bytes) 91encodePacket13 ctx recordLayer pkt = do 92 let pt = contentType pkt 93 mkRecord bs = Record pt TLS12 (fragmentPlaintext bs) 94 len = ctxFragmentSize ctx 95 records <- map mkRecord <$> packetToFragments13 ctx len pkt 96 fmap mconcat <$> forEitherM records (recordEncode13 recordLayer) 97 98packetToFragments13 :: Context -> Maybe Int -> Packet13 -> IO [ByteString] 99packetToFragments13 ctx len (Handshake13 hss) = 100 getChunks len . B.concat <$> mapM (updateHandshake13 ctx) hss 101packetToFragments13 _ _ (Alert13 a) = return [encodeAlerts a] 102packetToFragments13 _ _ (AppData13 x) = return [x] 103packetToFragments13 _ _ ChangeCipherSpec13 = return [encodeChangeCipherSpec] 104 105updateHandshake13 :: Context -> Handshake13 -> IO ByteString 106updateHandshake13 ctx hs 107 | isIgnored hs = return encoded 108 | otherwise = usingHState ctx $ do 109 when (isHRR hs) wrapAsMessageHash13 110 updateHandshakeDigest encoded 111 addHandshakeMessage encoded 112 return encoded 113 where 114 encoded = encodeHandshake13 hs 115 116 isHRR (ServerHello13 srand _ _ _) = isHelloRetryRequest srand 117 isHRR _ = False 118 119 isIgnored NewSessionTicket13{} = True 120 isIgnored KeyUpdate13{} = True 121 isIgnored _ = False 122