update utility with new ciphers and new credentials system.
This commit is contained in:
parent
5c776b7fc4
commit
fa0d01df0d
3 changed files with 33 additions and 13 deletions
|
@ -21,7 +21,9 @@ import Data.IORef
|
|||
|
||||
ciphers :: [Cipher]
|
||||
ciphers =
|
||||
[ cipher_AES128_SHA1
|
||||
[ cipher_DHE_RSA_AES128_SHA1
|
||||
, cipher_DHE_RSA_AES256_SHA1
|
||||
, cipher_AES128_SHA1
|
||||
, cipher_AES256_SHA1
|
||||
, cipher_RC4_128_MD5
|
||||
, cipher_RC4_128_SHA1
|
||||
|
@ -50,7 +52,6 @@ getDefaultParams flags host store sStorage session =
|
|||
{ pConnectVersion = tlsConnectVer
|
||||
, pAllowedVersions = [TLS10,TLS11,TLS12]
|
||||
, pCiphers = ciphers
|
||||
, pCertificates = Nothing
|
||||
, pLogging = logging
|
||||
, pSessionManager = sessionRef sStorage
|
||||
, onCertificatesRecv = crecv
|
||||
|
|
|
@ -24,9 +24,16 @@ import qualified Crypto.Random.AESCtr as RNG
|
|||
import Network.TLS
|
||||
import Network.TLS.Extra
|
||||
|
||||
import qualified Crypto.PubKey.DH as DH
|
||||
|
||||
ciphers :: [Cipher]
|
||||
ciphers =
|
||||
[ cipher_AES128_SHA1
|
||||
[ cipher_DHE_RSA_AES128_SHA1
|
||||
, cipher_DHE_RSA_AES256_SHA1
|
||||
, cipher_DHE_DSS_AES128_SHA1
|
||||
, cipher_DHE_DSS_AES256_SHA1
|
||||
, cipher_DHE_DSS_RC4_SHA1
|
||||
, cipher_AES128_SHA1
|
||||
, cipher_AES256_SHA1
|
||||
, cipher_RC4_128_MD5
|
||||
, cipher_RC4_128_SHA1
|
||||
|
@ -84,7 +91,7 @@ memSessionManager (MemSessionManager mvar) = SessionManager
|
|||
, sessionInvalidate = \_ -> return ()
|
||||
}
|
||||
|
||||
clientProcess certs handle dsthandle dbg sessionStorage _ = do
|
||||
clientProcess creds handle dsthandle dbg sessionStorage _ = do
|
||||
rng <- RNG.makeSystem
|
||||
let logging = if not dbg
|
||||
then defaultLogging
|
||||
|
@ -95,7 +102,7 @@ clientProcess certs handle dsthandle dbg sessionStorage _ = do
|
|||
let serverstate = defaultParamsServer --maybe id (setSessionManager . MemSessionManager) sessionStorage $ defaultParamsServer
|
||||
{ pAllowedVersions = [SSL3,TLS10,TLS11,TLS12]
|
||||
, pCiphers = ciphers
|
||||
, pCertificates = certs
|
||||
, pCredentials = creds
|
||||
, pLogging = logging
|
||||
, pSessionManager = maybe noSessionManager (memSessionManager . MemSessionManager) sessionStorage
|
||||
}
|
||||
|
@ -167,7 +174,6 @@ doClient source destination@(Address a _) flags = do
|
|||
let clientstate = defaultParamsClient { pConnectVersion = TLS10
|
||||
, pAllowedVersions = [TLS10,TLS11,TLS12]
|
||||
, pCiphers = ciphers
|
||||
, pCertificates = Nothing
|
||||
, pLogging = logging
|
||||
, onCertificatesRecv = crecv
|
||||
}
|
||||
|
@ -190,10 +196,18 @@ doClient source destination@(Address a _) flags = do
|
|||
return ()
|
||||
AddrFD _ _ -> error "bad error fd. not implemented"
|
||||
|
||||
loadCred (cert, priv) = do
|
||||
putStrLn ("loading credential " ++ show cert ++ " : key=" ++ show priv)
|
||||
res <- credentialLoadX509 cert priv
|
||||
case res of
|
||||
Left _ -> putStrLn "ERR"
|
||||
Right _ -> putStrLn "OK"
|
||||
return res
|
||||
|
||||
|
||||
doServer :: Address -> Address -> [Flag] -> IO ()
|
||||
doServer source destination flags = do
|
||||
cert <- fileReadCertificateChain $ getCertificate flags
|
||||
pk <- fileReadPrivateKey $ getKey flags
|
||||
creds <- (either (error . show) Credentials . sequence) `fmap` mapM loadCred (zip (getCertificate flags) (getKey flags))
|
||||
srcaddr <- getAddressDescription source
|
||||
dstaddr <- getAddressDescription destination
|
||||
|
||||
|
@ -211,7 +225,7 @@ doServer source destination flags = do
|
|||
StunnelSocket dst -> socketToHandle dst ReadWriteMode
|
||||
|
||||
_ <- forkIO $ finally
|
||||
(clientProcess (Just (cert, Just pk)) srch dsth (Debug `elem` flags) sessionStorage addr >> return ())
|
||||
(clientProcess creds srch dsth (Debug `elem` flags) sessionStorage addr >> return ())
|
||||
(hClose srch >> (when (dsth /= stdout) $ hClose dsth))
|
||||
return ()
|
||||
AddrFD _ _ -> error "bad error fd. not implemented"
|
||||
|
@ -262,12 +276,16 @@ getDestination opts = foldl accf defaultDestination opts
|
|||
accf (Address _ s) (DestinationType t) = Address t s
|
||||
accf acc _ = acc
|
||||
|
||||
getCertificate opts = foldl accf "certificate.pem" opts
|
||||
where accf _ (Certificate cert) = cert
|
||||
onNull def l | null l = def
|
||||
| otherwise = l
|
||||
|
||||
getCertificate :: [Flag] -> [String]
|
||||
getCertificate opts = reverse $ onNull ["certificate.pem"] $ foldl accf [] opts
|
||||
where accf acc (Certificate cert) = cert:acc
|
||||
accf acc _ = acc
|
||||
|
||||
getKey opts = foldl accf "certificate.key" opts
|
||||
where accf _ (Key key) = key
|
||||
getKey opts = reverse $ onNull ["certificate.key"] $ foldl accf [] opts
|
||||
where accf acc (Key key) = key : acc
|
||||
accf acc _ = acc
|
||||
|
||||
main :: IO ()
|
||||
|
|
|
@ -23,6 +23,7 @@ Executable tls-stunnel
|
|||
, bytestring
|
||||
, x509-system >= 1.0
|
||||
, cprng-aes >= 0.5.0
|
||||
, crypto-pubkey
|
||||
, tls >= 1.2 && < 1.3
|
||||
, tls-extra >= 0.7.0 && < 0.8
|
||||
if os(windows)
|
||||
|
|
Loading…
Reference in a new issue