move processServerHello in Handshake
This commit is contained in:
parent
f9ae636351
commit
f59804f459
6 changed files with 48 additions and 44 deletions
|
@ -110,8 +110,7 @@ instance Extension SecureRenegotiation where
|
||||||
extensionID _ = extensionID_SecureRenegotiation
|
extensionID _ = extensionID_SecureRenegotiation
|
||||||
extensionEncode (SecureRenegotiation cvd svd) =
|
extensionEncode (SecureRenegotiation cvd svd) =
|
||||||
runPut $ putOpaque8 (cvd `B.append` fromMaybe B.empty svd)
|
runPut $ putOpaque8 (cvd `B.append` fromMaybe B.empty svd)
|
||||||
extensionDecode isServerHello = runGetMaybe getSecureReneg
|
extensionDecode isServerHello = runGetMaybe $ do
|
||||||
where getSecureReneg = do
|
|
||||||
opaque <- getOpaque8
|
opaque <- getOpaque8
|
||||||
if isServerHello
|
if isServerHello
|
||||||
then let (cvd, svd) = B.splitAt (B.length opaque `div` 2) opaque
|
then let (cvd, svd) = B.splitAt (B.length opaque `div` 2) opaque
|
||||||
|
|
|
@ -20,9 +20,9 @@ import Network.TLS.Extension
|
||||||
import Network.TLS.IO
|
import Network.TLS.IO
|
||||||
import Network.TLS.State hiding (getNegotiatedProtocol)
|
import Network.TLS.State hiding (getNegotiatedProtocol)
|
||||||
import Network.TLS.Sending
|
import Network.TLS.Sending
|
||||||
import Network.TLS.Receiving
|
|
||||||
import Network.TLS.Measurement
|
import Network.TLS.Measurement
|
||||||
import Network.TLS.Wire (encodeWord16)
|
import Network.TLS.Wire (encodeWord16)
|
||||||
|
import Network.TLS.Util (bytesEq)
|
||||||
import Network.TLS.Types
|
import Network.TLS.Types
|
||||||
import Network.TLS.X509
|
import Network.TLS.X509
|
||||||
import Data.Maybe
|
import Data.Maybe
|
||||||
|
@ -32,6 +32,7 @@ import Data.ByteString.Char8 ()
|
||||||
|
|
||||||
import Control.Applicative ((<$>))
|
import Control.Applicative ((<$>))
|
||||||
import Control.Monad.State
|
import Control.Monad.State
|
||||||
|
import Control.Monad.Error
|
||||||
import Control.Exception (SomeException)
|
import Control.Exception (SomeException)
|
||||||
import qualified Control.Exception as E
|
import qualified Control.Exception as E
|
||||||
|
|
||||||
|
@ -65,7 +66,7 @@ handshakeClient cparams ctx = do
|
||||||
|
|
||||||
secureReneg =
|
secureReneg =
|
||||||
if pUseSecureRenegotiation params
|
if pUseSecureRenegotiation params
|
||||||
then usingState_ ctx (getVerifiedData True) >>= \vd -> return $ Just $ toExtensionRaw $ SecureRenegotiation vd Nothing
|
then usingState_ ctx (getVerifiedData ClientRole) >>= \vd -> return $ Just $ toExtensionRaw $ SecureRenegotiation vd Nothing
|
||||||
else return Nothing
|
else return Nothing
|
||||||
npnExtention = if isJust $ onNPNServerSuggest cparams
|
npnExtention = if isJust $ onNPNServerSuggest cparams
|
||||||
then return $ Just $ toExtensionRaw $ NextProtocolNegotiation []
|
then return $ Just $ toExtensionRaw $ NextProtocolNegotiation []
|
||||||
|
@ -261,6 +262,23 @@ sendClientData cparams ctx = sendCertificate >> sendClientKeyXchg >> sendCertifi
|
||||||
|
|
||||||
_ -> return ()
|
_ -> return ()
|
||||||
|
|
||||||
|
processServerHello :: Handshake -> TLSSt ()
|
||||||
|
processServerHello (ServerHello sver ran _ _ _ ex) = do
|
||||||
|
-- FIXME notify the user to take action if the extension requested is missing
|
||||||
|
-- secreneg <- getSecureRenegotiation
|
||||||
|
-- when (secreneg && (isNothing $ lookup 0xff01 ex)) $ ...
|
||||||
|
mapM_ processServerExtension ex
|
||||||
|
withHandshakeM $ setServerRandom ran
|
||||||
|
setVersion sver
|
||||||
|
where processServerExtension (0xff01, content) = do
|
||||||
|
cv <- getVerifiedData ClientRole
|
||||||
|
sv <- getVerifiedData ServerRole
|
||||||
|
let bs = extensionEncode (SecureRenegotiation cv $ Just sv)
|
||||||
|
unless (bs `bytesEq` content) $ throwError $ Error_Protocol ("server secure renegotiation data not matching", True, HandshakeFailure)
|
||||||
|
return ()
|
||||||
|
|
||||||
|
processServerExtension _ = return ()
|
||||||
|
processServerHello _ = error "processServerHello called on wrong type"
|
||||||
|
|
||||||
throwMiscErrorOnException :: MonadIO m => String -> SomeException -> m a
|
throwMiscErrorOnException :: MonadIO m => String -> SomeException -> m a
|
||||||
throwMiscErrorOnException msg e =
|
throwMiscErrorOnException msg e =
|
||||||
|
|
|
@ -147,8 +147,8 @@ handshakeServerWith sparams ctx clientHello@(ClientHello ver _ clientSession cip
|
||||||
secRengExt <- if secReneg
|
secRengExt <- if secReneg
|
||||||
then do
|
then do
|
||||||
vf <- usingState_ ctx $ do
|
vf <- usingState_ ctx $ do
|
||||||
cvf <- getVerifiedData True
|
cvf <- getVerifiedData ClientRole
|
||||||
svf <- getVerifiedData False
|
svf <- getVerifiedData ServerRole
|
||||||
return $ extensionEncode (SecureRenegotiation cvf $ Just svf)
|
return $ extensionEncode (SecureRenegotiation cvf $ Just svf)
|
||||||
return [ (0xff01, vf) ]
|
return [ (0xff01, vf) ]
|
||||||
else return []
|
else return []
|
||||||
|
|
|
@ -11,7 +11,6 @@
|
||||||
module Network.TLS.Receiving
|
module Network.TLS.Receiving
|
||||||
( processHandshake
|
( processHandshake
|
||||||
, processPacket
|
, processPacket
|
||||||
, processServerHello
|
|
||||||
, verifyRSA
|
, verifyRSA
|
||||||
) where
|
) where
|
||||||
|
|
||||||
|
@ -90,7 +89,7 @@ processHandshake hs = do
|
||||||
when (finishHandshakeTypeMaterial $ typeOfHandshake hs) $ withHandshakeM $ updateHandshakeDigest encoded
|
when (finishHandshakeTypeMaterial $ typeOfHandshake hs) $ withHandshakeM $ updateHandshakeDigest encoded
|
||||||
where -- secure renegotiation
|
where -- secure renegotiation
|
||||||
processClientExtension (0xff01, content) = do
|
processClientExtension (0xff01, content) = do
|
||||||
v <- getVerifiedData True
|
v <- getVerifiedData ClientRole
|
||||||
let bs = extensionEncode (SecureRenegotiation v Nothing)
|
let bs = extensionEncode (SecureRenegotiation v Nothing)
|
||||||
unless (bs `bytesEq` content) $ throwError $ Error_Protocol ("client verified data not matching: " ++ show v ++ ":" ++ show content, True, HandshakeFailure)
|
unless (bs `bytesEq` content) $ throwError $ Error_Protocol ("client verified data not matching: " ++ show v ++ ":" ++ show content, True, HandshakeFailure)
|
||||||
|
|
||||||
|
@ -114,24 +113,6 @@ verifyRSA hsh econtent sign = do
|
||||||
rsapriv <- fromJust "rsa client public key" . hstRSAClientPublicKey . fromJust "handshake" . stHandshake <$> get
|
rsapriv <- fromJust "rsa client public key" . hstRSAClientPublicKey . fromJust "handshake" . stHandshake <$> get
|
||||||
return $ kxVerify rsapriv hsh econtent sign
|
return $ kxVerify rsapriv hsh econtent sign
|
||||||
|
|
||||||
processServerHello :: Handshake -> TLSSt ()
|
|
||||||
processServerHello (ServerHello sver ran _ _ _ ex) = do
|
|
||||||
-- FIXME notify the user to take action if the extension requested is missing
|
|
||||||
-- secreneg <- getSecureRenegotiation
|
|
||||||
-- when (secreneg && (isNothing $ lookup 0xff01 ex)) $ ...
|
|
||||||
mapM_ processServerExtension ex
|
|
||||||
withHandshakeM $ setServerRandom ran
|
|
||||||
setVersion sver
|
|
||||||
where processServerExtension (0xff01, content) = do
|
|
||||||
cv <- getVerifiedData True
|
|
||||||
sv <- getVerifiedData False
|
|
||||||
let bs = extensionEncode (SecureRenegotiation cv $ Just sv)
|
|
||||||
unless (bs `bytesEq` content) $ throwError $ Error_Protocol ("server secure renegotiation data not matching", True, HandshakeFailure)
|
|
||||||
return ()
|
|
||||||
|
|
||||||
processServerExtension _ = return ()
|
|
||||||
processServerHello _ = error "processServerHello called on wrong type"
|
|
||||||
|
|
||||||
-- process the client key exchange message. the protocol expects the initial
|
-- process the client key exchange message. the protocol expects the initial
|
||||||
-- client version received in ClientHello, not the negotiated version.
|
-- client version received in ClientHello, not the negotiated version.
|
||||||
-- in case the version mismatch, generate a random master secret
|
-- in case the version mismatch, generate a random master secret
|
||||||
|
|
|
@ -242,8 +242,8 @@ setClientCertificateChain s = modify (\st -> st { stClientCertificateChain = Jus
|
||||||
getClientCertificateChain :: MonadState TLSState m => m (Maybe CertificateChain)
|
getClientCertificateChain :: MonadState TLSState m => m (Maybe CertificateChain)
|
||||||
getClientCertificateChain = gets stClientCertificateChain
|
getClientCertificateChain = gets stClientCertificateChain
|
||||||
|
|
||||||
getVerifiedData :: MonadState TLSState m => Bool -> m Bytes
|
getVerifiedData :: MonadState TLSState m => Role -> m Bytes
|
||||||
getVerifiedData client = gets (if client then stClientVerifiedData else stServerVerifiedData)
|
getVerifiedData client = gets (if client == ClientRole then stClientVerifiedData else stServerVerifiedData)
|
||||||
|
|
||||||
isClientContext :: MonadState TLSState m => m Role
|
isClientContext :: MonadState TLSState m => m Role
|
||||||
isClientContext = getRecordState stClientContext
|
isClientContext = getRecordState stClientContext
|
||||||
|
|
|
@ -82,6 +82,7 @@ data Flag = Verbose | Debug | NoValidateCert | Session | Http11
|
||||||
| NoSNI
|
| NoSNI
|
||||||
| Uri String
|
| Uri String
|
||||||
| UserAgent String
|
| UserAgent String
|
||||||
|
| Output String
|
||||||
| Help
|
| Help
|
||||||
deriving (Show,Eq)
|
deriving (Show,Eq)
|
||||||
|
|
||||||
|
@ -90,6 +91,7 @@ options =
|
||||||
[ Option ['v'] ["verbose"] (NoArg Verbose) "verbose output on stdout"
|
[ Option ['v'] ["verbose"] (NoArg Verbose) "verbose output on stdout"
|
||||||
, Option ['d'] ["debug"] (NoArg Debug) "TLS debug output on stdout"
|
, Option ['d'] ["debug"] (NoArg Debug) "TLS debug output on stdout"
|
||||||
, Option ['s'] ["session"] (NoArg Session) "try to resume a session"
|
, Option ['s'] ["session"] (NoArg Session) "try to resume a session"
|
||||||
|
, Option ['O'] ["output"] (ReqArg Output "stdout") "output "
|
||||||
, Option [] ["no-validation"] (NoArg NoValidateCert) "disable certificate validation"
|
, Option [] ["no-validation"] (NoArg NoValidateCert) "disable certificate validation"
|
||||||
, Option [] ["http1.1"] (NoArg Http11) "use http1.1 instead of http1.0"
|
, Option [] ["http1.1"] (NoArg Http11) "use http1.1 instead of http1.0"
|
||||||
, Option [] ["ssl3"] (NoArg Ssl3) "use SSL 3.0 as default"
|
, Option [] ["ssl3"] (NoArg Ssl3) "use SSL 3.0 as default"
|
||||||
|
@ -114,18 +116,19 @@ runOn (sStorage, certStore) flags port hostname = do
|
||||||
++ userAgent
|
++ userAgent
|
||||||
++ "\r\n\r\n")
|
++ "\r\n\r\n")
|
||||||
when (Verbose `elem` flags) (putStrLn "sending query:" >> LC.putStrLn query >> putStrLn "")
|
when (Verbose `elem` flags) (putStrLn "sending query:" >> LC.putStrLn query >> putStrLn "")
|
||||||
|
out <- maybe (return stdout) (flip openFile WriteMode) getOutput
|
||||||
runTLS (getDefaultParams flags hostname certStore sStorage sess) hostname port $ \ctx -> do
|
runTLS (getDefaultParams flags hostname certStore sStorage sess) hostname port $ \ctx -> do
|
||||||
handshake ctx
|
handshake ctx
|
||||||
sendData ctx $ query
|
sendData ctx $ query
|
||||||
loopRecv ctx
|
loopRecv out ctx
|
||||||
bye ctx
|
bye ctx
|
||||||
return ()
|
return ()
|
||||||
loopRecv ctx = do
|
loopRecv out ctx = do
|
||||||
d <- timeout 2000000 (recvData ctx) -- 2s per recv
|
d <- timeout 2000000 (recvData ctx) -- 2s per recv
|
||||||
case d of
|
case d of
|
||||||
Nothing -> when (Debug `elem` flags) (hPutStrLn stderr "timeout") >> return ()
|
Nothing -> when (Debug `elem` flags) (hPutStrLn stderr "timeout") >> return ()
|
||||||
Just b | BC.null b -> return ()
|
Just b | BC.null b -> return ()
|
||||||
| otherwise -> BC.putStrLn b >> loopRecv ctx
|
| otherwise -> BC.hPutStrLn out b >> loopRecv out ctx
|
||||||
|
|
||||||
findURI [] = "/"
|
findURI [] = "/"
|
||||||
findURI (Uri u:_) = u
|
findURI (Uri u:_) = u
|
||||||
|
@ -135,6 +138,9 @@ runOn (sStorage, certStore) flags port hostname = do
|
||||||
mUserAgent = foldl f Nothing flags
|
mUserAgent = foldl f Nothing flags
|
||||||
where f _ (UserAgent ua) = Just ua
|
where f _ (UserAgent ua) = Just ua
|
||||||
f acc _ = acc
|
f acc _ = acc
|
||||||
|
getOutput = foldl f Nothing flags
|
||||||
|
where f _ (Output o) = Just o
|
||||||
|
f acc _ = acc
|
||||||
|
|
||||||
printUsage =
|
printUsage =
|
||||||
putStrLn $ usageInfo "usage: simpleclient [opts] <hostname> [port]\n\n\t(port default to: 443)\noptions:\n" options
|
putStrLn $ usageInfo "usage: simpleclient [opts] <hostname> [port]\n\n\t(port default to: 443)\noptions:\n" options
|
||||||
|
|
Loading…
Reference in a new issue