yogsototh/hs-tls
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

remaining cleanup and reactive all options, and tls-extra removal

Browse source
This commit is contained in:
Vincent Hanquez 2014-01-27 04:03:53 +00:00
parent 8b03b9ca86
commit 228928bf15
4 changed files with 12 additions and 23 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
debug/src/RetrieveCertificate.hs
View file

@ -1,7 +1,7 @@
{-# LANGUAGE ScopedTypeVariables, DeriveDataTypeable, ViewPatterns #-}
import Network.TLS
import Network.TLS.Extra
import Network.TLS.Extra.Cipher
import Network.BSD
import Network.Socket
@ -10,7 +10,6 @@ import Data.Default.Class
import Data.IORef
import Data.X509 as X509
import Data.X509.Validation
import System.X509
import Control.Applicative
import Control.Monad

9
debug/src/SimpleClient.hs
View file

@ -3,7 +3,7 @@
import Network.BSD
import Network.Socket (socket, Family(..), SocketType(..), sClose, SockAddr(..), connect)
import Network.TLS
import Network.TLS.Extra
import Network.TLS.Extra.Cipher
import System.Console.GetOpt
import System.IO
import System.Timeout
@ -42,7 +42,6 @@ runTLS debug params hostname portNumber f = do
let sockaddr = SockAddrInet portNumber (head $ hostAddresses he)
E.catch (connect sock sockaddr)
(\(e :: SomeException) -> sClose sock >> error ("cannot open socket " ++ show sockaddr ++ " " ++ show e))
--dsth <- socketToHandle sock ReadWriteMode
ctx <- contextNew sock params rng
contextHookSetLogging ctx logging
() <- f ctx
@ -68,17 +67,11 @@ getDefaultParams flags host store sStorage session =
, sharedValidationCache = validateCache
}
}
--, onCertificatesRecv = crecv
--}
where
validateCache
| validateCert = def
| otherwise = ValidationCache (\_ _ _ -> return ValidationCachePass)
(\_ _ _ -> return ())
--checks = defaultChecks (Just host)
--crecv = if validateCert
-- then certificateChecks checks store
-- else certificateNoChecks
tlsConnectVer
| Tls12 `elem` flags = TLS12

19
debug/src/Stunnel.hs
View file

@ -8,6 +8,7 @@ import System.Console.GetOpt
import System.Environment (getArgs)
import System.Exit
import System.X509
import Data.X509.Validation
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as L
@ -23,7 +24,7 @@ import Data.Default.Class
import qualified Crypto.Random.AESCtr as RNG
import Network.TLS
import Network.TLS.Extra
import Network.TLS.Extra.Cipher
import qualified Crypto.PubKey.DH as DH ()
@ -177,15 +178,14 @@ doClient source destination@(Address a _) flags = do
}
store <- getSystemCertificateStore
{-
let checks = defaultChecks (Just a)
let crecv = if not (NoCertValidation `elem` flags)
then certificateChecks checks store
else certificateNoChecks
-}
let clientstate = (defaultParamsClient "" B.empty)
let validateCache
| NoCertValidation `elem` flags =
ValidationCache (\_ _ _ -> return ValidationCachePass)
(\_ _ _ -> return ())
| otherwise = def
let clientstate = (defaultParamsClient a B.empty)
{ clientSupported = def { supportedCiphers = ciphers }
, clientShared = def { sharedCAStore = store }
, clientShared = def { sharedCAStore = store, sharedValidationCache = validateCache }
}
case srcaddr of
@ -200,6 +200,7 @@ doClient source destination@(Address a _) flags = do
dsth <- socketToHandle dst ReadWriteMode
dstctx <- contextNew dsth clientstate rng
contextHookSetLogging dstctx logging
_ <- forkIO $ finally
(tlsclient srch dstctx)
(hClose srch >> hClose dsth)

4
debug/tls-debug.cabal
View file

@ -26,7 +26,6 @@ Executable tls-stunnel
, data-default-class
, crypto-pubkey
, tls >= 1.2 && < 1.3
, tls-extra >= 0.7.0 && < 0.8
if os(windows)
Buildable: False
else
@ -42,7 +41,6 @@ Executable tls-stunnel
-- , cprng-aes
-- , x509-system >= 1.0
-- , tls >= 1.2 && < 1.3
-- , tls-extra >= 0.7 && < 0.8
-- Buildable: True
-- ghc-options: -Wall -fno-warn-missing-signatures
@ -60,7 +58,6 @@ Executable tls-retrievecertificate
, x509-system >= 1.4
, x509-validation >= 1.5.0
, tls >= 1.2 && < 1.3
, tls-extra >= 0.7 && < 0.8
Buildable: True
ghc-options: -Wall -fno-warn-missing-signatures
@ -74,7 +71,6 @@ Executable tls-simpleclient
, cprng-aes >= 0.5.0
, x509-system >= 1.0
, tls >= 1.2 && < 1.3
, tls-extra >= 0.7 && < 0.8
Buildable: True
ghc-options: -Wall -fno-warn-missing-signatures