diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,3 +1,19 @@ +## Version 1.3.3 + +- Add support for Hans (Haskell Network Stack) (Adam Wick) +- Add support for ECDSA signature +- Add support for ECDSA-ECDHE Cipher +- Improve parsing of ECC related structure + +## Version 1.3.2 + +- Add cipher suites for forward secrecy on more clients (Aaron Friel) +- Maintain more handshake information to be queried by protocol (Adam Wick) +- handle SCSV on client and server side (Kazu Yamamoto) +- Cleanup renegotiation logic (Kazu Yamamoto) +- Various testing improvements with the openssl test parts +- Cleanup AEAD handling for future support of other ciphers + ## Version 1.3.1 - Repair DHE RSA handling on the cipher by creating signature properly diff --git a/Network/TLS.hs b/Network/TLS.hs --- a/Network/TLS.hs +++ b/Network/TLS.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- | -- Module : Network.TLS -- License : BSD-style @@ -48,7 +49,9 @@ -- * Creating a context , contextNew , contextNewOnHandle +#ifdef INCLUDE_NETWORK , contextNewOnSocket +#endif , contextFlush , contextClose , contextHookSetHandshakeRecv diff --git a/Network/TLS/Backend.hs b/Network/TLS/Backend.hs --- a/Network/TLS/Backend.hs +++ b/Network/TLS/Backend.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- | -- Module : Network.TLS.Backend -- License : BSD-style @@ -20,13 +21,21 @@ , Backend(..) ) where -import Control.Monad -import Network.Socket (Socket, sClose) -import qualified Network.Socket.ByteString as Socket import Data.ByteString (ByteString) import qualified Data.ByteString as B import System.IO (Handle, hSetBuffering, BufferMode(..), hFlush, hClose) +#ifdef INCLUDE_NETWORK +import Control.Monad +import qualified Network.Socket as Network (Socket, sClose) +import qualified Network.Socket.ByteString as Network +#endif + +#ifdef INCLUDE_HANS +import qualified Data.ByteString.Lazy as L +import qualified Hans.NetworkStack as Hans +#endif + -- | Connection IO backend data Backend = Backend { backendFlush :: IO () -- ^ Flush the connection sending buffer, if any. @@ -43,16 +52,36 @@ initializeBackend _ = return () getBackend = id -instance HasBackend Socket where +#ifdef INCLUDE_NETWORK +instance HasBackend Network.Socket where initializeBackend _ = return () - getBackend sock = Backend (return ()) (sClose sock) (Socket.sendAll sock) recvAll + getBackend sock = Backend (return ()) (Network.sClose sock) (Network.sendAll sock) recvAll where recvAll n = B.concat `fmap` loop n where loop 0 = return [] loop left = do - r <- Socket.recv sock left + r <- Network.recv sock left if B.null r then return [] else liftM (r:) (loop (left - B.length r)) +#endif + +#ifdef INCLUDE_HANS +instance HasBackend Hans.Socket where + initializeBackend _ = return () + getBackend sock = Backend (return ()) (Hans.close sock) sendAll recvAll + where sendAll x = do + amt <- fromIntegral `fmap` Hans.sendBytes sock (L.fromStrict x) + if (amt == 0) || (amt == B.length x) + then return () + else sendAll (B.drop amt x) + recvAll n = loop (fromIntegral n) L.empty + loop 0 acc = return (L.toStrict acc) + loop left acc = do + r <- Hans.recvBytes sock left + if L.null r + then loop 0 acc + else loop (left - L.length r) (acc `L.append` r) +#endif instance HasBackend Handle where initializeBackend handle = hSetBuffering handle NoBuffering diff --git a/Network/TLS/Context.hs b/Network/TLS/Context.hs --- a/Network/TLS/Context.hs +++ b/Network/TLS/Context.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} -- | -- Module : Network.TLS.Context -- License : BSD-style @@ -41,7 +42,9 @@ , contextNew -- * Deprecated new contexts methods , contextNewOnHandle +#ifdef INCLUDE_NETWORK , contextNewOnSocket +#endif -- * Context hooks , contextHookSetHandshakeRecv @@ -80,7 +83,9 @@ import Data.IORef -- deprecated imports +#ifdef INCLUDE_NETWORK import Network.Socket (Socket) +#endif import System.IO (Handle) class TLSParams a where @@ -194,6 +199,7 @@ contextNewOnHandle handle params = contextNew handle params {-# DEPRECATED contextNewOnHandle "use contextNew" #-} +#ifdef INCLUDE_NETWORK -- | create a new context on a socket. contextNewOnSocket :: (MonadIO m, TLSParams params) => Socket -- ^ Socket of the connection. @@ -201,6 +207,7 @@ -> m Context contextNewOnSocket sock params = contextNew sock params {-# DEPRECATED contextNewOnSocket "use contextNew" #-} +#endif contextHookSetHandshakeRecv :: Context -> (Handshake -> IO Handshake) -> IO () contextHookSetHandshakeRecv context f = diff --git a/Network/TLS/Crypto.hs b/Network/TLS/Crypto.hs --- a/Network/TLS/Crypto.hs +++ b/Network/TLS/Crypto.hs @@ -36,16 +36,22 @@ import Data.ByteString (ByteString) import Crypto.Random import qualified Crypto.PubKey.DSA as DSA +import qualified Crypto.PubKey.ECC.ECDSA as ECDSA +import qualified Crypto.PubKey.ECC.Prim as ECC +import qualified Crypto.PubKey.ECC.Types as ECC import qualified Crypto.PubKey.RSA as RSA import qualified Crypto.PubKey.RSA.PKCS15 as RSA +import Crypto.Number.Serialize (os2ip) +import Crypto.Number.Basic (numBits) -import Data.X509 (PrivKey(..), PubKey(..)) +import Data.X509 (PrivKey(..), PubKey(..), PubKeyEC(..), SerializedPoint(..)) import Network.TLS.Crypto.DH import Network.TLS.Crypto.ECDH import Data.ASN1.Types import Data.ASN1.Encoding import Data.ASN1.BinaryEncoding (DER(..), BER(..)) +import Data.List (find) {-# DEPRECATED PublicKey "use PubKey" #-} type PublicKey = PubKey @@ -168,6 +174,59 @@ Just $ DSA.Signature { DSA.sign_r = r, DSA.sign_s = s } _ -> Nothing +kxVerify (PubKeyEC key) alg msg sigBS = maybe False id $ do + -- get the curve name and the public key data + (curveName, pubBS) <- case key of + PubKeyEC_Named curveName' pub -> Just (curveName',pub) + PubKeyEC_Prime {} -> + case find matchPrimeCurve $ enumFrom $ toEnum 0 of + Nothing -> Nothing + Just curveName' -> Just (curveName', pubkeyEC_pub key) + -- decode the signature + signature <- case decodeASN1' BER sigBS of + Left _ -> Nothing + Right [Start Sequence,IntVal r,IntVal s,End Sequence] -> Just $ ECDSA.Signature r s + Right _ -> Nothing + + -- decode the public key related to the curve + pubkey <- unserializePoint (ECC.getCurveByName curveName) pubBS + + verifyF <- case alg of + MD5 -> Just (ECDSA.verify H.MD5) + SHA1 -> Just (ECDSA.verify H.SHA1) + SHA224 -> Just (ECDSA.verify H.SHA224) + SHA256 -> Just (ECDSA.verify H.SHA256) + SHA384 -> Just (ECDSA.verify H.SHA384) + SHA512 -> Just (ECDSA.verify H.SHA512) + _ -> Nothing + return $ verifyF pubkey signature msg + where + matchPrimeCurve c = + case ECC.getCurveByName c of + ECC.CurveFP (ECC.CurvePrime p cc) -> + ECC.ecc_a cc == pubkeyEC_a key && + ECC.ecc_b cc == pubkeyEC_b key && + ECC.ecc_n cc == pubkeyEC_order key && + p == pubkeyEC_prime key + _ -> False + + unserializePoint curve (SerializedPoint bs) = + case B.uncons bs of + Nothing -> Nothing + Just (ptFormat, input) -> + case ptFormat of + 4 -> if B.length bs == 2 * bytes + then Nothing + else + let (x, y) = B.splitAt bytes input + p = ECC.Point (os2ip x) (os2ip y) + in if ECC.isPointValid curve p + then Just $ ECDSA.PublicKey curve p + else Nothing + -- 2 and 3 for compressed format. + _ -> Nothing + where bits = numBits . ECC.ecc_n . ECC.common_curve $ curve + bytes = (bits + 7) `div` 8 kxVerify _ _ _ _ = False -- Sign the given message using the private key. @@ -183,8 +242,8 @@ sign <- DSA.sign pk H.SHA1 msg return (Right $ encodeASN1' DER $ dsaSequence sign) where dsaSequence sign = [Start Sequence,IntVal (DSA.sign_r sign),IntVal (DSA.sign_s sign),End Sequence] ---kxSign g _ _ _ = --- (Left KxUnsupported, g) +--kxSign _ _ _ = +-- return (Left KxUnsupported) rsaSignHash :: MonadRandom m => Hash -> RSA.PrivateKey -> ByteString -> m (Either RSA.Error ByteString) rsaSignHash SHA1_MD5 pk msg = RSA.signSafer noHash pk msg diff --git a/Network/TLS/Extension.hs b/Network/TLS/Extension.hs --- a/Network/TLS/Extension.hs +++ b/Network/TLS/Extension.hs @@ -54,8 +54,8 @@ import Network.TLS.Struct (ExtensionID, EnumSafe8(..), EnumSafe16(..), HashAndSignatureAlgorithm) import Network.TLS.Wire import Network.TLS.Packet (putSignatureHashAlgorithm, getSignatureHashAlgorithm) -import Network.BSD (HostName) +type HostName = String -- central list defined in extensionID_ServerName diff --git a/Network/TLS/Extra/Cipher.hs b/Network/TLS/Extra/Cipher.hs --- a/Network/TLS/Extra/Cipher.hs +++ b/Network/TLS/Extra/Cipher.hs @@ -37,6 +37,7 @@ , cipher_ECDHE_RSA_AES128GCM_SHA256 , cipher_ECDHE_RSA_AES128CBC_SHA256 , cipher_ECDHE_RSA_AES128CBC_SHA + , cipher_ECDHE_ECDSA_AES128GCM_SHA256 ) where import qualified Data.ByteString as B @@ -117,7 +118,9 @@ -- this choice of ciphersuite should satisfy most normal need ciphersuite_all :: [Cipher] ciphersuite_all = - [ cipher_DHE_RSA_AES256_SHA256, cipher_DHE_RSA_AES128_SHA256 + [ cipher_ECDHE_RSA_AES128GCM_SHA256 + , cipher_ECDHE_ECDSA_AES128GCM_SHA256 + , cipher_DHE_RSA_AES256_SHA256, cipher_DHE_RSA_AES128_SHA256 , cipher_DHE_RSA_AES256_SHA1, cipher_DHE_RSA_AES128_SHA1 , cipher_DHE_DSS_AES256_SHA1, cipher_DHE_DSS_AES128_SHA1 , cipher_AES128_SHA256, cipher_AES256_SHA256 @@ -133,7 +136,7 @@ -- | the strongest ciphers supported. ciphersuite_strong :: [Cipher] -ciphersuite_strong = [cipher_DHE_RSA_AES256_SHA256, cipher_AES256_SHA256, cipher_AES256_SHA1] +ciphersuite_strong = [cipher_ECDHE_RSA_AES128GCM_SHA256, cipher_ECDHE_ECDSA_AES128GCM_SHA256, cipher_DHE_RSA_AES256_SHA256, cipher_AES256_SHA256, cipher_AES256_SHA1] -- | DHE-RSA cipher suite ciphersuite_dhe_rsa :: [Cipher] @@ -411,6 +414,15 @@ , cipherMinVer = Just TLS12 -- RFC 5288 Sec 4 } +cipher_ECDHE_ECDSA_AES128GCM_SHA256 :: Cipher +cipher_ECDHE_ECDSA_AES128GCM_SHA256 = Cipher + { cipherID = 0xc02b + , cipherName = "ECDHE-ECDSA-AES128GCM-SHA256" + , cipherBulk = bulk_aes128gcm + , cipherHash = SHA256 + , cipherKeyExchange = CipherKeyExchange_ECDHE_ECDSA + , cipherMinVer = Just TLS12 -- RFC 5289 + } {- TLS 1.0 ciphers definition diff --git a/Network/TLS/Handshake/Client.hs b/Network/TLS/Handshake/Client.hs --- a/Network/TLS/Handshake/Client.hs +++ b/Network/TLS/Handshake/Client.hs @@ -67,13 +67,11 @@ ,secureReneg ,npnExtention ,alpnExtension - {- - ,curveExtension, + ,curveExtension ,ecPointExtension - ,sessionTicketExtension - ,heartbeatExtension - -} + --,sessionTicketExtension ,signatureAlgExtension + -- ,heartbeatExtension ] toExtensionRaw :: Extension e => e -> ExtensionRaw @@ -97,14 +95,11 @@ then return $ Just $ toExtensionRaw $ ServerName [ServerNameHostName $ fst $ clientServerIdentification cparams] else return Nothing - {- - curveExtension = return $ Just $ toExtensionRaw $ EllipticCurvesSupported [NamedCurve_secp256k1,NamedCurve_secp256r1] - ecPointExtension = return $ Just $ toExtensionRaw $ EcPointFormatsSupported [EcPointFormat_Uncompressed,EcPointFormat_AnsiX962_compressed_prime,EcPointFormat_AnsiX962_compressed_char2] - - sessionTicketExtension = return $ Just $ toExtensionRaw $ SessionTicket - - heartbeatExtension = return $ Just $ toExtensionRaw $ HeartBeat $ HeartBeat_PeerAllowedToSend - -} + curveExtension = return $ Just $ toExtensionRaw $ EllipticCurvesSupported availableEllipticCurves + ecPointExtension = return $ Just $ toExtensionRaw $ EcPointFormatsSupported [EcPointFormat_Uncompressed] + --[EcPointFormat_Uncompressed,EcPointFormat_AnsiX962_compressed_prime,EcPointFormat_AnsiX962_compressed_char2] + --heartbeatExtension = return $ Just $ toExtensionRaw $ HeartBeat $ HeartBeat_PeerAllowedToSend + --sessionTicketExtension = return $ Just $ toExtensionRaw $ SessionTicket signatureAlgExtension = return $ Just $ toExtensionRaw $ SignatureAlgorithms $ supportedHashSignatures $ clientSupported cparams @@ -205,6 +200,7 @@ CipherKeyExchange_DHE_RSA -> getCKX_DHE CipherKeyExchange_DHE_DSS -> getCKX_DHE CipherKeyExchange_ECDHE_RSA -> getCKX_ECDHE + CipherKeyExchange_ECDHE_ECDSA -> getCKX_ECDHE _ -> throwCore $ Error_Protocol ("client key exchange unsupported type", True, HandshakeFailure) sendPacket ctx $ Handshake [ClientKeyXchg ckx] where getCKX_DHE = do @@ -380,6 +376,8 @@ doDHESignature dhparams signature SignatureDSS (CipherKeyExchange_ECDHE_RSA, SKX_ECDHE_RSA ecdhparams signature) -> do doECDHESignature ecdhparams signature SignatureRSA + (CipherKeyExchange_ECDHE_ECDSA, SKX_ECDHE_ECDSA ecdhparams signature) -> do + doECDHESignature ecdhparams signature SignatureECDSA (cke, SKX_Unparsed bytes) -> do ver <- usingState_ ctx getVersion case decodeReallyServerKeyXchgAlgorithmData ver cke bytes of diff --git a/Network/TLS/Handshake/Signature.hs b/Network/TLS/Handshake/Signature.hs --- a/Network/TLS/Handshake/Signature.hs +++ b/Network/TLS/Handshake/Signature.hs @@ -82,12 +82,20 @@ Just HashSHA256 -> SHA256 Just HashSHA1 -> SHA1 Nothing -> SHA1_MD5 - _ -> error ("unimplemented signature hash type") + Just hash -> error ("unimplemented RSA signature hash type: " ++ show hash) signatureHashData SignatureDSS mhash = case mhash of Nothing -> SHA1 Just HashSHA1 -> SHA1 Just _ -> error "invalid DSA hash choice, only SHA1 allowed" +signatureHashData SignatureECDSA mhash = + case mhash of + Just HashSHA512 -> SHA512 + Just HashSHA384 -> SHA384 + Just HashSHA256 -> SHA256 + Just HashSHA1 -> SHA1 + Nothing -> SHA1_MD5 + Just hash -> error ("unimplemented ECDSA signature hash type: " ++ show hash) signatureHashData sig _ = error ("unimplemented signature type: " ++ show sig) --signatureCreate :: Context -> Maybe HashAndSignatureAlgorithm -> HashDescr -> Bytes -> IO DigitallySigned @@ -124,9 +132,10 @@ signatureVerifyWithHashDescr ctx sigAlgExpected (DigitallySigned _ bs) (hashDescr, toVerify) = do cc <- usingState_ ctx $ isClientContext case sigAlgExpected of - SignatureRSA -> verifyRSA ctx cc hashDescr toVerify bs - SignatureDSS -> verifyRSA ctx cc hashDescr toVerify bs - _ -> error "not implemented yet" + SignatureRSA -> verifyRSA ctx cc hashDescr toVerify bs + SignatureDSS -> verifyRSA ctx cc hashDescr toVerify bs + SignatureECDSA -> verifyRSA ctx cc hashDescr toVerify bs + _ -> error "signature verification not implemented yet" digitallySignParams :: Context -> Bytes -> SignatureAlgorithm -> IO DigitallySigned digitallySignParams ctx signatureData sigAlg = do diff --git a/Network/TLS/Packet.hs b/Network/TLS/Packet.hs --- a/Network/TLS/Packet.hs +++ b/Network/TLS/Packet.hs @@ -291,17 +291,21 @@ parseCKE CipherKeyExchange_DHE_DSS = parseClientDHPublic parseCKE CipherKeyExchange_DH_Anon = parseClientDHPublic parseCKE CipherKeyExchange_ECDHE_RSA = parseClientECDHPublic + parseCKE CipherKeyExchange_ECDHE_ECDSA = parseClientECDHPublic parseCKE _ = error "unsupported client key exchange type" parseClientDHPublic = CKX_DH . dhPublic <$> getInteger16 parseClientECDHPublic = do - len <- getWord8 - _ <- getWord8 -- Magic number 4 - let siz = fromIntegral len `div` 2 - xb <- getBytes siz - yb <- getBytes siz - let x = os2ip xb - y = os2ip yb - return $ CKX_ECDH $ ecdhPublic x y siz + len <- getWord8 + formatTy <- getWord8 + case formatTy of + 4 -> do -- uncompressed + let siz = fromIntegral len `div` 2 + xb <- getBytes siz + yb <- getBytes siz + let x = os2ip xb + y = os2ip yb + return $ CKX_ECDH $ ecdhPublic x y siz + _ -> error ("unsupported EC format type: " ++ show formatTy) decodeServerKeyXchg_DH :: Get ServerDHParams decodeServerKeyXchg_DH = getServerDHParams @@ -332,6 +336,10 @@ dhparams <- getServerECDHParams signature <- getDigitallySigned ver return $ SKX_ECDHE_RSA dhparams signature + CipherKeyExchange_ECDHE_ECDSA -> do + dhparams <- getServerECDHParams + signature <- getDigitallySigned ver + return $ SKX_ECDHE_ECDSA dhparams signature _ -> do bs <- remaining >>= getBytes return $ SKX_Unknown bs @@ -395,6 +403,7 @@ SKX_DHE_RSA params sig -> putServerDHParams params >> putDigitallySigned sig SKX_DHE_DSS params sig -> putServerDHParams params >> putDigitallySigned sig SKX_ECDHE_RSA params sig -> putServerECDHParams params >> putDigitallySigned sig + SKX_ECDHE_ECDSA params sig -> putServerECDHParams params >> putDigitallySigned sig SKX_Unparsed bytes -> putBytes bytes _ -> error ("encodeHandshakeContent: cannot handle: " ++ show skg) @@ -490,15 +499,29 @@ getServerECDHParams :: Get ServerECDHParams getServerECDHParams = do - _ <- getWord8 -- ECParameters ECCurveType: curve name type, should be 3 - w16 <- getWord16 -- ECParameters NamedCurve - mxy <- getOpaque16 -- ECPoint - let xy = B.drop 1 mxy - siz = B.length xy `div` 2 - (xb,yb) = B.splitAt siz xy - x = os2ip xb - y = os2ip yb - return $ ServerECDHParams (ecdhParams w16) (ecdhPublic x y siz) + curveType <- getWord8 + case curveType of + 1 -> do -- explicit prime + _prime <- getOpaque8 + _a <- getOpaque8 + _b <- getOpaque8 + _base <- getOpaque8 + _order <- getOpaque8 + _cofactor <- getOpaque8 + error "cannot handle explicit prime ECDH Params" + 2 -> -- explicit_char2 + error "cannot handle explicit char2 ECDH Params" + 3 -> do -- ECParameters ECCurveType: curve name type + w16 <- getWord16 -- ECParameters NamedCurve + mxy <- getOpaque8 -- ECPoint + let xy = B.drop 1 mxy + siz = B.length xy `div` 2 + (xb,yb) = B.splitAt siz xy + x = os2ip xb + y = os2ip yb + return $ ServerECDHParams (ecdhParams w16) (ecdhPublic x y siz) + _ -> + error "unknown type for ECDH Params" putServerECDHParams :: ServerECDHParams -> Put putServerECDHParams (ServerECDHParams ecdhparams ecdhpub) = do diff --git a/Network/TLS/Parameters.hs b/Network/TLS/Parameters.hs --- a/Network/TLS/Parameters.hs +++ b/Network/TLS/Parameters.hs @@ -22,8 +22,6 @@ , CertificateRejectReason(..) ) where -import Network.BSD (HostName) - import Network.TLS.Extension import Network.TLS.Struct import qualified Network.TLS.Struct as Struct @@ -37,6 +35,8 @@ import Data.Monoid import Data.Default.Class import qualified Data.ByteString as B + +type HostName = String type CommonParams = (Supported, Shared) diff --git a/Network/TLS/Struct.hs b/Network/TLS/Struct.hs --- a/Network/TLS/Struct.hs +++ b/Network/TLS/Struct.hs @@ -285,6 +285,7 @@ | SKX_DHE_DSS ServerDHParams DigitallySigned | SKX_DHE_RSA ServerDHParams DigitallySigned | SKX_ECDHE_RSA ServerECDHParams DigitallySigned + | SKX_ECDHE_ECDSA ServerECDHParams DigitallySigned | SKX_RSA (Maybe ServerRSAParams) | SKX_DH_DSS (Maybe ServerRSAParams) | SKX_DH_RSA (Maybe ServerRSAParams) diff --git a/tls.cabal b/tls.cabal --- a/tls.cabal +++ b/tls.cabal @@ -1,5 +1,5 @@ Name: tls -Version: 1.3.2 +Version: 1.3.3 Description: Native Haskell TLS and SSL protocol implementation for server and client. . @@ -31,24 +31,37 @@ Description: Accept SSLv2 compatible handshake Default: True +Flag network + Description: Use the base network library + Default: True + +Flag hans + Description: Use the Haskell Network Stack (HaNS) + Default: False + Library Build-Depends: base >= 3 && < 5 , mtl , transformers , cereal >= 0.4 , bytestring - , network , data-default-class -- crypto related , memory - , cryptonite >= 0.3 + , cryptonite >= 0.7 -- certificate related , asn1-types >= 0.2.0 , asn1-encoding - , x509 >= 1.6 && < 1.7.0 + , x509 >= 1.6.2 && < 1.7.0 , x509-store >= 1.6 - , x509-validation >= 1.6 && < 1.7.0 + , x509-validation >= 1.6.3 && < 1.7.0 , async + if flag(network) + Build-Depends: network + cpp-options: -DINCLUDE_NETWORK + if flag(hans) + Build-Depends: hans + cpp-options: -DINCLUDE_HANS Exposed-modules: Network.TLS Network.TLS.Cipher Network.TLS.Compression