peyotls 0.1.1.0 → 0.1.2.0

raw patch · 6 files changed

+52/−28 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• examples/clcertClient.hs +1/−4
• examples/clcertEcdsaClient.hs +2/−4
• examples/eccClient.hs +1/−4
• examples/simpleClient.hs +1/−4
• peyotls.cabal +9/−11
• src/Network/PeyoTLS/Client.hs +38/−1

@@ -21,10 +21,7 @@ 	h <- connectTo "localhost" $ PortNumber 443 	g <- cprgCreate <$> createEntropyPool :: IO SystemRNG 	(`run` g) $ do-		p <- open h ["TLS_RSA_WITH_AES_128_CBC_SHA"] [(rk, rc)] ca-		nms <- getNames p-		unless ("localhost" `elem` nms) $-			error "certificate name mismatch"+		p <- open' h "localhost" ["TLS_RSA_WITH_AES_128_CBC_SHA"] [(rk, rc)] ca 		hlPut p "GET / HTTP/1.1 \r\n" 		hlPut p "Host: localhost\r\n\r\n" 		doUntil BSC.null (hlGetLine p) >>= liftIO . mapM_ BSC.putStrLn

@@ -23,10 +23,8 @@ 	h <- connectTo "localhost" $ PortNumber 443 	g <- cprgCreate <$> createEntropyPool :: IO SystemRNG 	(`run` g) $ do-		p <- open h ["TLS_RSA_WITH_AES_128_CBC_SHA"] [(ek, ec), (rk, rc)] ca-		nms <- getNames p-		unless ("localhost" `elem` nms) $-			error "certificate name mismatch"+		p <- open' h "localhost"+			["TLS_RSA_WITH_AES_128_CBC_SHA"] [(ek, ec), (rk, rc)] ca 		hlPut p "GET / HTTP/1.1 \r\n" 		hlPut p "Host: localhost\r\n\r\n" 		doUntil BSC.null (hlGetLine p) >>= liftIO . mapM_ BSC.putStrLn

@@ -30,10 +30,7 @@ 	h <- connectTo "localhost" $ PortNumber 443 	g <- cprgCreate <$> createEntropyPool :: IO SystemRNG 	(`run` g) $ do-		p <- open h cipherSuites [] ca-		nms <- getNames p-		unless ("localhost" `elem` nms p) $-			error "certificate name mismatch"+		p <- open' h "localhost" cipherSuites [] ca 		hlPut p "GET / HTTP/1.1 \r\n" 		hlPut p "Host: localhost\r\n\r\n" 		doUntil BSC.null (hlGetLine p) >>= liftIO . mapM_ BSC.putStrLn

@@ -19,10 +19,7 @@ 	h <- connectTo "localhost" $ PortNumber 443 	g <- cprgCreate <$> createEntropyPool :: IO SystemRNG 	(`run` g) $ do-		p <- open h ["TLS_RSA_WITH_AES_128_CBC_SHA"] [] ca-		nms <- getNames p-		unless ("localhost" `elem` nms) $-			error "certificate name mismatch"+		p <- open' h "localhost" ["TLS_RSA_WITH_AES_128_CBC_SHA"] [] ca 		hlPut p "GET / HTTP/1.1 \r\n" 		hlPut p "Host: localhost\r\n\r\n" 		doUntil BSC.null (hlGetLine p) >>= liftIO . mapM_ BSC.putStrLn

@@ -2,7 +2,7 @@ cabal-version:	>= 1.8  name:		peyotls-version:	0.1.1.0+version:	0.1.2.0 stability:	Experimental author:		Yoshikuni Jujo <PAF01143@nifty.ne.jp> maintainer:	Yoshikuni Jujo <PAF01143@nifty.ne.jp>@@ -147,10 +147,8 @@     > 	h <- connectTo "localhost" $ PortNumber 443     > 	g <- cprgCreate <$> createEntropyPool :: IO SystemRNG     > 	(`run` g) $ do-    > 		p <- open h ["TLS_RSA_WITH_AES_128_CBC_SHA"] [] ca+    > 		p <- open' h "localhost" ["TLS_RSA_WITH_AES_128_CBC_SHA"] [] ca     >		nms <- getNames p-    > 		unless ("localhost" `elem` nms) $-    > 			error "certificate name mismatch"     > 		hlPut p "GET / HTTP/1.1 \r\n"     > 		hlPut p "Host: localhost\r\n\r\n"     > 		doUntil BSC.null (hlGetLine p) >>= liftIO . mapM_ BSC.putStrLn@@ -181,9 +179,9 @@     > >	rk <- readKey "client_rsa.key"     > >	rc <- readCertificateChain ["client_rsa.crt"]     > 20c22-    > <		p <- open h ["TLS_RSA_WITH_AES_128_CBC_SHA"] [] ca+    > <		p <- open' h "localhost" ["TLS_RSA_WITH_AES_128_CBC_SHA"] [] ca     > ----    > >		p <- open h ["TLS_RSA_WITH_AES_128_CBC_SHA"] [(rk, rc)] ca+    > >		p <- open' h "localhost" ["TLS_RSA_WITH_AES_128_CBC_SHA"] [(rk, rc)] ca     .     Client certificate client (ECDSA or RSA certificate)     .@@ -194,9 +192,9 @@     > >	ek <- readKey "client_ecdsa.key"     > >	ec <- readCertificateChain ["client_ecdsa.crt"]     > 22c24-    > <		p <- open h ["TLS_RSA_WITH_AES_128_CBC_SHA"] [(rk, rc)] ca+    > <		p <- open' h "localhost" ["TLS_RSA_WITH_AES_128_CBC_SHA"] [(rk, rc)] ca     > ----    > >		p <- open h ["TLS_RSA_WITH_AES_128_CBC_SHA"] [(ek, ec), (rk, rc)] ca+    > >		p <- open' h "localhost" ["TLS_RSA_WITH_AES_128_CBC_SHA"] [(ek, ec), (rk, rc)] ca     .     ECC server (use ECC or RSA depending on client)     .@@ -246,9 +244,9 @@     > >       "TLS_RSA_WITH_AES_128_CBC_SHA" ]     > >     > 20c31-    > <               p <- open h ["TLS_RSA_WITH_AES_128_CBC_SHA"] [] ca+    > <               p <- open' h "localhost" ["TLS_RSA_WITH_AES_128_CBC_SHA"] [] ca     > ----    > >               p <- open h cipherSuites [] ca+    > >               p <- open' h "localhost" cipherSuites [] ca     .  extra-source-files:@@ -283,7 +281,7 @@ source-repository	this     type:	git     location:	git://github.com/YoshikuniJujo/peyotls.git-    tag:	peyotls-0.1.1.0+    tag:	peyotls-0.1.2.0  library     hs-source-dirs:	src

@@ -12,7 +12,8 @@  module Network.PeyoTLS.Client ( 	-- * Basic-	PeyotlsM, PeyotlsHandle, TlsM, TlsHandle, run, open, getNames,+	PeyotlsM, PeyotlsHandle, TlsM, TlsHandle,+	run, open, open', getNames, checkName, 	-- * Renegotiation 	renegotiate, setCipherSuites, setKeyCerts, setCertificateStore, 	-- * Cipher Suite@@ -25,6 +26,7 @@ import "monads-tf" Control.Monad.Error.Class (strMsg) import Data.Maybe (fromMaybe) import Data.List (find, intersect)+import Data.Function (on) import Data.HandleLike (HandleLike(..)) import System.IO (Handle) import "crypto-random" Crypto.Random (CPRG, SystemRNG, cprgGenerate)@@ -84,12 +86,47 @@ getNames :: HandleLike h => TlsHandle h g -> TlsM h g [String] getNames = BASE.getNames . tlsHandleC +checkName :: HandleLike h => TlsHandle h g -> String -> TlsM h g Bool+checkName t n = flip toCheckName n `liftM` getNames t++toCheckName :: [String] -> String -> Bool+toCheckName s0s s = any (`toCheckName1` s) s0s++toCheckName1 :: String -> String -> Bool+toCheckName1 = on checkSepNames $ sepBy '.'++sepBy :: Eq a => a ->[a] -> [[a]]+sepBy x0 xs+	| (t, _ : d) <- span (/= x0) xs = t : sepBy x0 d+	| otherwise = [xs]++checkSepNames :: [String] -> [String] -> Bool+checkSepNames [] [] = True+checkSepNames _ [] = False+checkSepNames [] _ = False+checkSepNames ("*" : ns0) (_ : ns) = checkSepNames ns0 ns+checkSepNames (n0 : ns0) (n : ns) = n0 == n && checkSepNames ns0 ns++-- | Don't forget check server name by checkName.+ open :: (ValidateHandle h, CPRG g) => h -> [CipherSuite] -> 	[(CertSecretKey, X509.CertificateChain)] -> X509.CertificateStore -> 	TlsM h g (TlsHandle h g) open h cscl crts ca = (TlsHandleC `liftM`) . execHandshakeM h $ do 	setSettingsC (cscl, crts, ca) 	handshake crts ca =<< clientHello cscl++-- | This function open and check server name.+--   Use this so as not to forget to check server name.++open' :: (ValidateHandle h, CPRG g) => h -> String -> [CipherSuite] ->+	[(CertSecretKey, X509.CertificateChain)] -> X509.CertificateStore ->+	TlsM h g (TlsHandle h g)+open' h n cscl crts ca = do+	t <- open h cscl crts ca+	c <- checkName t n+	unless c . E.throwError $ strMsg "certificate name mismatch"+	return t  renegotiate :: (ValidateHandle h, CPRG g) => TlsHandle h g -> TlsM h g () renegotiate (TlsHandleC t) = rerunHandshakeM t $ do