Hello community,
here is the log from the commit of package ghc-tls for openSUSE:Factory checked
in at 2016-01-08 15:22:40
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Comparing /work/SRC/openSUSE:Factory/ghc-tls (Old)
and /work/SRC/openSUSE:Factory/.ghc-tls.new (New)
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "ghc-tls"
Changes:
--------
--- /work/SRC/openSUSE:Factory/ghc-tls/ghc-tls.changes 2015-09-02
00:36:11.000000000 +0200
+++ /work/SRC/openSUSE:Factory/.ghc-tls.new/ghc-tls.changes 2016-01-08
15:22:41.000000000 +0100
@@ -1,0 +2,9 @@
+Tue Dec 15 20:50:00 UTC 2015 - mimi...@gmail.com
+
+- update to 1.3.4
+* Add support for Hans (Haskell Network Stack)
+* Add support for ECDSA signature
+* Add support for ECDSA-ECDHE Cipher
+* Improve parsing of ECC related structure
+
+-------------------------------------------------------------------
Old:
----
tls-1.3.2.tar.gz
New:
----
tls-1.3.4.tar.gz
++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Other differences:
------------------
++++++ ghc-tls.spec ++++++
--- /var/tmp/diff_new_pack.IsnVCZ/_old 2016-01-08 15:22:42.000000000 +0100
+++ /var/tmp/diff_new_pack.IsnVCZ/_new 2016-01-08 15:22:42.000000000 +0100
@@ -21,7 +21,7 @@
%bcond_with tests
Name: ghc-tls
-Version: 1.3.2
+Version: 1.3.4
Release: 0
Summary: TLS/SSL protocol native implementation (Server and Client)
License: BSD-3-Clause
++++++ tls-1.3.2.tar.gz -> tls-1.3.4.tar.gz ++++++
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/tls-1.3.2/CHANGELOG.md new/tls-1.3.4/CHANGELOG.md
--- old/tls-1.3.2/CHANGELOG.md 2015-08-24 07:44:53.000000000 +0200
+++ new/tls-1.3.4/CHANGELOG.md 2015-12-12 15:51:40.000000000 +0100
@@ -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 -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/tls-1.3.2/Network/TLS/Backend.hs
new/tls-1.3.4/Network/TLS/Backend.hs
--- old/tls-1.3.2/Network/TLS/Backend.hs 2015-08-24 07:44:53.000000000
+0200
+++ new/tls-1.3.4/Network/TLS/Backend.hs 2015-12-12 15:51:40.000000000
+0100
@@ -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 -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/tls-1.3.2/Network/TLS/Context.hs
new/tls-1.3.4/Network/TLS/Context.hs
--- old/tls-1.3.2/Network/TLS/Context.hs 2015-08-24 07:44:53.000000000
+0200
+++ new/tls-1.3.4/Network/TLS/Context.hs 2015-12-12 15:51:40.000000000
+0100
@@ -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 -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/tls-1.3.2/Network/TLS/Core.hs
new/tls-1.3.4/Network/TLS/Core.hs
--- old/tls-1.3.2/Network/TLS/Core.hs 2015-08-24 07:44:53.000000000 +0200
+++ new/tls-1.3.4/Network/TLS/Core.hs 2015-12-12 15:51:40.000000000 +0100
@@ -20,6 +20,9 @@
-- * Next Protocol Negotiation
, getNegotiatedProtocol
+ -- * Server Name Indication
+ , getClientSNI
+
-- * High level API
, sendData
, recvData
@@ -56,6 +59,13 @@
getNegotiatedProtocol :: MonadIO m => Context -> m (Maybe B.ByteString)
getNegotiatedProtocol ctx = liftIO $ usingState_ ctx S.getNegotiatedProtocol
+type HostName = String
+
+-- | If the Server Name Indication extension has been used, return the
+-- hostname specified by the client.
+getClientSNI :: MonadIO m => Context -> m (Maybe HostName)
+getClientSNI ctx = liftIO $ usingState_ ctx S.getClientSNI
+
-- | sendData sends a bunch of data.
-- It will automatically chunk data to acceptable packet size
sendData :: MonadIO m => Context -> L.ByteString -> m ()
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/tls-1.3.2/Network/TLS/Crypto.hs
new/tls-1.3.4/Network/TLS/Crypto.hs
--- old/tls-1.3.2/Network/TLS/Crypto.hs 2015-08-24 07:44:53.000000000 +0200
+++ new/tls-1.3.4/Network/TLS/Crypto.hs 2015-12-12 15:51:40.000000000 +0100
@@ -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 -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/tls-1.3.2/Network/TLS/Extension.hs
new/tls-1.3.4/Network/TLS/Extension.hs
--- old/tls-1.3.2/Network/TLS/Extension.hs 2015-08-24 07:44:53.000000000
+0200
+++ new/tls-1.3.4/Network/TLS/Extension.hs 2015-12-12 15:51:40.000000000
+0100
@@ -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
<http://www.iana.org/assignments/tls-extensiontype-values/tls-extensiontype-values.txt>
extensionID_ServerName
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/tls-1.3.2/Network/TLS/Extra/Cipher.hs
new/tls-1.3.4/Network/TLS/Extra/Cipher.hs
--- old/tls-1.3.2/Network/TLS/Extra/Cipher.hs 2015-08-24 07:44:53.000000000
+0200
+++ new/tls-1.3.4/Network/TLS/Extra/Cipher.hs 2015-12-12 15:51:40.000000000
+0100
@@ -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 -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/tls-1.3.2/Network/TLS/Handshake/Client.hs
new/tls-1.3.4/Network/TLS/Handshake/Client.hs
--- old/tls-1.3.2/Network/TLS/Handshake/Client.hs 2015-08-24
07:44:53.000000000 +0200
+++ new/tls-1.3.4/Network/TLS/Handshake/Client.hs 2015-12-12
15:51:40.000000000 +0100
@@ -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 -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/tls-1.3.2/Network/TLS/Handshake/Server.hs
new/tls-1.3.4/Network/TLS/Handshake/Server.hs
--- old/tls-1.3.2/Network/TLS/Handshake/Server.hs 2015-08-24
07:44:53.000000000 +0200
+++ new/tls-1.3.4/Network/TLS/Handshake/Server.hs 2015-12-12
15:51:40.000000000 +0100
@@ -28,7 +28,8 @@
import Network.TLS.Handshake.Process
import Network.TLS.Handshake.Key
import Network.TLS.Measurement
-import Data.Maybe (isJust)
+import Data.Monoid
+import Data.Maybe (isJust, listToMaybe, mapMaybe)
import Data.List (intersect, sortBy)
import qualified Data.ByteString as B
import Data.ByteString.Char8 ()
@@ -111,9 +112,16 @@
when (null commonCompressions) $ throwCore $
Error_Protocol ("no compression in common with the client", True,
HandshakeFailure)
+ let serverName = case extensionDecode False `fmap` (lookup
extensionID_ServerName exts) of
+ Just (Just (ServerName ns)) -> listToMaybe (mapMaybe toHostName ns)
+ where toHostName (ServerNameHostName hostName) = Just hostName
+ toHostName (ServerNameOther _) = Nothing
+ _ -> Nothing
+
let ciphersFilteredVersion = filter (cipherAllowedForVersion
chosenVersion) commonCiphers
usedCipher = (onCipherChoosing $ serverHooks sparams) chosenVersion
ciphersFilteredVersion
- creds = sharedCredentials $ ctxShared ctx
+ extraCreds <- (onServerNameIndication $ serverHooks sparams) serverName
+ let creds = extraCreds `mappend` (sharedCredentials $ ctxShared ctx)
cred <- case cipherKeyExchange usedCipher of
CipherKeyExchange_RSA -> return $
credentialsFindForDecrypting creds
CipherKeyExchange_DH_Anon -> return $ Nothing
@@ -126,6 +134,8 @@
(Session (Just clientSessionId)) -> liftIO $ sessionResume
(sharedSessionManager $ ctxShared ctx) clientSessionId
(Session Nothing) -> return Nothing
+ maybe (return ()) (usingState_ ctx . setClientSNI) serverName
+
case extensionDecode False `fmap` (lookup
extensionID_ApplicationLayerProtocolNegotiation exts) of
Just (Just (ApplicationLayerProtocolNegotiation protos)) ->
usingState_ ctx $ setClientALPNSuggest protos
_ -> return ()
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/tls-1.3.2/Network/TLS/Handshake/Signature.hs
new/tls-1.3.4/Network/TLS/Handshake/Signature.hs
--- old/tls-1.3.2/Network/TLS/Handshake/Signature.hs 2015-08-24
07:44:53.000000000 +0200
+++ new/tls-1.3.4/Network/TLS/Handshake/Signature.hs 2015-12-12
15:51:40.000000000 +0100
@@ -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 -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/tls-1.3.2/Network/TLS/Packet.hs
new/tls-1.3.4/Network/TLS/Packet.hs
--- old/tls-1.3.2/Network/TLS/Packet.hs 2015-08-24 07:44:53.000000000 +0200
+++ new/tls-1.3.4/Network/TLS/Packet.hs 2015-12-12 15:51:40.000000000 +0100
@@ -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 -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/tls-1.3.2/Network/TLS/Parameters.hs
new/tls-1.3.4/Network/TLS/Parameters.hs
--- old/tls-1.3.2/Network/TLS/Parameters.hs 2015-08-24 07:44:53.000000000
+0200
+++ new/tls-1.3.4/Network/TLS/Parameters.hs 2015-12-12 15:51:40.000000000
+0100
@@ -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
@@ -38,6 +36,8 @@
import Data.Default.Class
import qualified Data.ByteString as B
+type HostName = String
+
type CommonParams = (Supported, Shared)
data ClientParams = ClientParams
@@ -134,6 +134,13 @@
-- If 'True', servers reject handshakes which suggest
-- a lower protocol than the highest protocol supported.
, supportedFallbackScsv :: Bool
+ -- | In ver <= TLS1.0, block ciphers using CBC are using CBC residue as
IV, which can be guessed
+ -- by an attacker. Hence, an empty packet is normally sent before a
normal data packet, to
+ -- prevent guessability. Some Microsoft TLS-based protocol
implementations, however,
+ -- consider these empty packets as a protocol violation and disconnect.
If this parameter is
+ -- 'False', empty packets will never be added, which is less secure, but
might help in rare
+ -- cases.
+ , supportedEmptyPacket :: Bool
} deriving (Show,Eq)
defaultSupported :: Supported
@@ -152,6 +159,7 @@
, supportedClientInitiatedRenegotiation = False
, supportedSession = True
, supportedFallbackScsv = True
+ , supportedEmptyPacket = True
}
instance Default Supported where
@@ -239,6 +247,15 @@
-- The client cipher list cannot be empty.
, onCipherChoosing :: Version -> [Cipher] -> Cipher
+ -- | Allow the server to indicate additional credentials
+ -- to be used depending on the host name indicated by the
+ -- client.
+ --
+ -- This is most useful for transparent proxies where
+ -- credentials must be generated on the fly according to
+ -- the host the client is trying to connect to.
+ , onServerNameIndication :: Maybe HostName -> IO Credentials
+
-- | suggested next protocols accoring to the next protocol negotiation
extension.
, onSuggestNextProtocols :: IO (Maybe [B.ByteString])
-- | at each new handshake, we call this hook to see if we allow
handshake to happens.
@@ -251,6 +268,7 @@
{ onCipherChoosing = \_ -> head
, onClientCertificate = \_ -> return $ CertificateUsageReject $
CertificateRejectOther "no client certificates expected"
, onUnverifiedClientCert = return False
+ , onServerNameIndication = \_ -> return mempty
, onSuggestNextProtocols = return Nothing
, onNewHandshake = \_ -> return True
, onALPNClientSuggest = Nothing
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/tls-1.3.2/Network/TLS/Sending.hs
new/tls-1.3.4/Network/TLS/Sending.hs
--- old/tls-1.3.2/Network/TLS/Sending.hs 2015-08-24 07:44:53.000000000
+0200
+++ new/tls-1.3.4/Network/TLS/Sending.hs 2015-12-12 15:51:40.000000000
+0100
@@ -6,7 +6,7 @@
-- Portability : unknown
--
-- the Sending module contains calls related to marshalling packets according
--- to the TLS state
+-- to the TLS state
--
module Network.TLS.Sending (writePacket) where
@@ -88,5 +88,5 @@
return (v, c)
liftIO $ modifyMVar_ (ctxTxState ctx) (\_ -> return tx)
-- set empty packet counter measure if condition are met
- when (ver <= TLS10 && cc == ClientRole && isCBC tx) $ liftIO $ writeIORef
(ctxNeedEmptyPacket ctx) True
+ when (ver <= TLS10 && cc == ClientRole && isCBC tx && supportedEmptyPacket
(ctxSupported ctx)) $ liftIO $ writeIORef (ctxNeedEmptyPacket ctx) True
where isCBC tx = maybe False (\c -> bulkBlockSize (cipherBulk c) > 0)
(stCipher tx)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/tls-1.3.2/Network/TLS/State.hs
new/tls-1.3.4/Network/TLS/State.hs
--- old/tls-1.3.2/Network/TLS/State.hs 2015-08-24 07:44:53.000000000 +0200
+++ new/tls-1.3.4/Network/TLS/State.hs 2015-12-12 15:51:40.000000000 +0100
@@ -45,6 +45,8 @@
, getClientEcPointFormatSuggest
, getClientCertificateChain
, setClientCertificateChain
+ , setClientSNI
+ , getClientSNI
, getVerifiedData
, setSession
, getSession
@@ -67,6 +69,8 @@
import Crypto.Random
import Data.X509 (CertificateChain)
+type HostName = String
+
data TLSState = TLSState
{ stSession :: Session
, stSessionResuming :: Bool
@@ -82,6 +86,7 @@
, stClientEllipticCurveSuggest :: Maybe [NamedCurve]
, stClientEcPointFormatSuggest :: Maybe [EcPointFormat]
, stClientCertificateChain :: Maybe CertificateChain
+ , stClientSNI :: Maybe HostName
, stRandomGen :: StateRNG
, stVersion :: Maybe Version
, stClientContext :: Role
@@ -116,6 +121,7 @@
, stClientEllipticCurveSuggest = Nothing
, stClientEcPointFormatSuggest = Nothing
, stClientCertificateChain = Nothing
+ , stClientSNI = Nothing
, stRandomGen = rng
, stVersion = Nothing
, stClientContext = clientContext
@@ -238,6 +244,12 @@
getClientCertificateChain :: TLSSt (Maybe CertificateChain)
getClientCertificateChain = gets stClientCertificateChain
+setClientSNI :: HostName -> TLSSt ()
+setClientSNI hn = modify (\st -> st { stClientSNI = Just hn })
+
+getClientSNI :: TLSSt (Maybe HostName)
+getClientSNI = gets stClientSNI
+
getVerifiedData :: Role -> TLSSt Bytes
getVerifiedData client = gets (if client == ClientRole then
stClientVerifiedData else stServerVerifiedData)
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/tls-1.3.2/Network/TLS/Struct.hs
new/tls-1.3.4/Network/TLS/Struct.hs
--- old/tls-1.3.2/Network/TLS/Struct.hs 2015-08-24 07:44:53.000000000 +0200
+++ new/tls-1.3.4/Network/TLS/Struct.hs 2015-12-12 15:51:40.000000000 +0100
@@ -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 -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/tls-1.3.2/Network/TLS.hs new/tls-1.3.4/Network/TLS.hs
--- old/tls-1.3.2/Network/TLS.hs 2015-08-24 07:44:53.000000000 +0200
+++ new/tls-1.3.4/Network/TLS.hs 2015-12-12 15:51:40.000000000 +0100
@@ -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
@@ -77,6 +80,9 @@
-- * Next Protocol Negotiation
, getNegotiatedProtocol
+ -- * Server Name Indication
+ , getClientSNI
+
-- * High level API
, sendData
, recvData
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/tls-1.3.2/Tests/Certificate.hs
new/tls-1.3.4/Tests/Certificate.hs
--- old/tls-1.3.2/Tests/Certificate.hs 2015-08-24 07:44:53.000000000 +0200
+++ new/tls-1.3.4/Tests/Certificate.hs 2015-12-12 15:51:40.000000000 +0100
@@ -20,7 +20,7 @@
instance Arbitrary Date where
arbitrary = do
- y <- choose (1951, 2050)
+ y <- choose (1971, 2035)
m <- elements [ January .. December]
d <- choose (1, 30)
return $ normalizeDate $ Date y m d
diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn'
'--exclude=.svnignore' old/tls-1.3.2/tls.cabal new/tls-1.3.4/tls.cabal
--- old/tls-1.3.2/tls.cabal 2015-08-24 07:44:53.000000000 +0200
+++ new/tls-1.3.4/tls.cabal 2015-12-12 15:51:40.000000000 +0100
@@ -1,5 +1,5 @@
Name: tls
-Version: 1.3.2
+Version: 1.3.4
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
