move processServerHello in Handshake

core/Network/TLS/Extension.hs

@@ -110,13 +110,12 @@ instance Extension SecureRenegotiation where
     extensionID _ = extensionID_SecureRenegotiation
     extensionEncode (SecureRenegotiation cvd svd) =
         runPut $ putOpaque8 (cvd `B.append` fromMaybe B.empty svd)
-    extensionDecode isServerHello = runGetMaybe getSecureReneg
-        where getSecureReneg = do
-                  opaque <- getOpaque8
-                  if isServerHello
-                     then let (cvd, svd) = B.splitAt (B.length opaque `div` 2) opaque
-                           in return $ SecureRenegotiation cvd (Just svd)
-                     else return $ SecureRenegotiation opaque Nothing
+    extensionDecode isServerHello = runGetMaybe $ do
+        opaque <- getOpaque8
+        if isServerHello
+           then let (cvd, svd) = B.splitAt (B.length opaque `div` 2) opaque
+                 in return $ SecureRenegotiation cvd (Just svd)
+           else return $ SecureRenegotiation opaque Nothing
 
 -- | Next Protocol Negotiation
 data NextProtocolNegotiation = NextProtocolNegotiation [ByteString]

core/Network/TLS/Handshake/Client.hs

@@ -20,9 +20,9 @@ import Network.TLS.Extension
 import Network.TLS.IO
 import Network.TLS.State hiding (getNegotiatedProtocol)
 import Network.TLS.Sending
-import Network.TLS.Receiving
 import Network.TLS.Measurement
 import Network.TLS.Wire (encodeWord16)
+import Network.TLS.Util (bytesEq)
 import Network.TLS.Types
 import Network.TLS.X509
 import Data.Maybe
@@ -32,6 +32,7 @@ import Data.ByteString.Char8 ()
 
 import Control.Applicative ((<$>))
 import Control.Monad.State
+import Control.Monad.Error
 import Control.Exception (SomeException)
 import qualified Control.Exception as E
 
@@ -65,7 +66,7 @@ handshakeClient cparams ctx = do
 
         secureReneg  =
                 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
         npnExtention = if isJust $ onNPNServerSuggest cparams
                          then return $ Just $ toExtensionRaw $ NextProtocolNegotiation []
@@ -261,6 +262,23 @@ sendClientData cparams ctx = sendCertificate >> sendClientKeyXchg >> sendCertifi
 
                 _ -> 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 msg e =

core/Network/TLS/Handshake/Server.hs

@@ -147,8 +147,8 @@ handshakeServerWith sparams ctx clientHello@(ClientHello ver _ clientSession cip
             secRengExt <- if secReneg
                     then do
                             vf <- usingState_ ctx $ do
-                                    cvf <- getVerifiedData True
-                                    svf <- getVerifiedData False
+                                    cvf <- getVerifiedData ClientRole
+                                    svf <- getVerifiedData ServerRole
                                     return $ extensionEncode (SecureRenegotiation cvf $ Just svf)
                             return [ (0xff01, vf) ]
                     else return []

core/Network/TLS/Receiving.hs

@@ -11,7 +11,6 @@
 module Network.TLS.Receiving
     ( processHandshake
     , processPacket
-    , processServerHello
     , verifyRSA
     ) where
 
@@ -90,7 +89,7 @@ processHandshake hs = do
     when (finishHandshakeTypeMaterial $ typeOfHandshake hs) $ withHandshakeM $ updateHandshakeDigest encoded
   where -- secure renegotiation
         processClientExtension (0xff01, content) = do
-            v <- getVerifiedData True
+            v <- getVerifiedData ClientRole
             let bs = extensionEncode (SecureRenegotiation v Nothing)
             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
     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
 -- client version received in ClientHello, not the negotiated version.
 -- in case the version mismatch, generate a random master secret

core/Network/TLS/State.hs

@@ -242,8 +242,8 @@ setClientCertificateChain s = modify (\st -> st { stClientCertificateChain = Jus
 getClientCertificateChain :: MonadState TLSState m => m (Maybe CertificateChain)
 getClientCertificateChain = gets stClientCertificateChain
 
-getVerifiedData :: MonadState TLSState m => Bool -> m Bytes
-getVerifiedData client = gets (if client then stClientVerifiedData else stServerVerifiedData)
+getVerifiedData :: MonadState TLSState m => Role -> m Bytes
+getVerifiedData client = gets (if client == ClientRole then stClientVerifiedData else stServerVerifiedData)
 
 isClientContext :: MonadState TLSState m => m Role
 isClientContext = getRecordState stClientContext

debug/src/SimpleClient.hs

@@ -82,6 +82,7 @@ data Flag = Verbose | Debug | NoValidateCert | Session | Http11
           | NoSNI
           | Uri String
           | UserAgent String
+          | Output String
           | Help
           deriving (Show,Eq)
 
@@ -90,6 +91,7 @@ options =
     [ Option ['v']  ["verbose"] (NoArg Verbose) "verbose output on stdout"
     , Option ['d']  ["debug"]   (NoArg Debug) "TLS debug output on stdout"
     , 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 []     ["http1.1"] (NoArg Http11) "use http1.1 instead of http1.0"
     , Option []     ["ssl3"]    (NoArg Ssl3) "use SSL 3.0 as default"
@@ -106,7 +108,7 @@ runOn (sStorage, certStore) flags port hostname = do
     when (Session `elem` flags) $ do
         session <- readIORef sStorage
         doTLS (Just session)
-    where doTLS sess = do
+  where doTLS sess = do
             let query = LC.pack (
                         "GET "
                         ++ findURI flags
@@ -114,27 +116,31 @@ runOn (sStorage, certStore) flags port hostname = do
                         ++ userAgent
                         ++ "\r\n\r\n")
             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
                 handshake ctx
                 sendData ctx $ query
-                loopRecv ctx
+                loopRecv out ctx
                 bye ctx
                 return ()
-          loopRecv ctx = do
+        loopRecv out ctx = do
             d <- timeout 2000000 (recvData ctx) -- 2s per recv
             case d of
                 Nothing            -> when (Debug `elem` flags) (hPutStrLn stderr "timeout") >> return ()
                 Just b | BC.null b -> return ()
-                       | otherwise -> BC.putStrLn b >> loopRecv ctx
+                       | otherwise -> BC.hPutStrLn out b >> loopRecv out ctx
 
-          findURI []        = "/"
-          findURI (Uri u:_) = u
-          findURI (_:xs)    = findURI xs
+        findURI []        = "/"
+        findURI (Uri u:_) = u
+        findURI (_:xs)    = findURI xs
 
-          userAgent = maybe "" (\s -> "\r\nUser-Agent: " ++ s) mUserAgent
-          mUserAgent = foldl f Nothing flags
-            where f _   (UserAgent ua) = Just ua
-                  f acc _              = acc
+        userAgent = maybe "" (\s -> "\r\nUser-Agent: " ++ s) mUserAgent
+        mUserAgent = foldl f Nothing flags
+          where f _   (UserAgent ua) = Just ua
+                f acc _              = acc
+        getOutput = foldl f Nothing flags
+          where f _   (Output o) = Just o
+                f acc _          = acc
 
 printUsage =
     putStrLn $ usageInfo "usage: simpleclient [opts] <hostname> [port]\n\n\t(port default to: 443)\noptions:\n" options