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]
|
||||||
ciphers =
|
ciphers =
|
||||||
[ cipher_AES128_SHA1
|
[ cipher_DHE_RSA_AES128_SHA1
|
||||||
|
, cipher_DHE_RSA_AES256_SHA1
|
||||||
|
, cipher_AES128_SHA1
|
||||||
, cipher_AES256_SHA1
|
, cipher_AES256_SHA1
|
||||||
, cipher_RC4_128_MD5
|
, cipher_RC4_128_MD5
|
||||||
, cipher_RC4_128_SHA1
|
, cipher_RC4_128_SHA1
|
||||||
|
@ -50,7 +52,6 @@ getDefaultParams flags host store sStorage session =
|
||||||
{ pConnectVersion = tlsConnectVer
|
{ pConnectVersion = tlsConnectVer
|
||||||
, pAllowedVersions = [TLS10,TLS11,TLS12]
|
, pAllowedVersions = [TLS10,TLS11,TLS12]
|
||||||
, pCiphers = ciphers
|
, pCiphers = ciphers
|
||||||
, pCertificates = Nothing
|
|
||||||
, pLogging = logging
|
, pLogging = logging
|
||||||
, pSessionManager = sessionRef sStorage
|
, pSessionManager = sessionRef sStorage
|
||||||
, onCertificatesRecv = crecv
|
, onCertificatesRecv = crecv
|
||||||
|
|
|
@ -24,9 +24,16 @@ import qualified Crypto.Random.AESCtr as RNG
|
||||||
import Network.TLS
|
import Network.TLS
|
||||||
import Network.TLS.Extra
|
import Network.TLS.Extra
|
||||||
|
|
||||||
|
import qualified Crypto.PubKey.DH as DH
|
||||||
|
|
||||||
ciphers :: [Cipher]
|
ciphers :: [Cipher]
|
||||||
ciphers =
|
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_AES256_SHA1
|
||||||
, cipher_RC4_128_MD5
|
, cipher_RC4_128_MD5
|
||||||
, cipher_RC4_128_SHA1
|
, cipher_RC4_128_SHA1
|
||||||
|
@ -84,7 +91,7 @@ memSessionManager (MemSessionManager mvar) = SessionManager
|
||||||
, sessionInvalidate = \_ -> return ()
|
, sessionInvalidate = \_ -> return ()
|
||||||
}
|
}
|
||||||
|
|
||||||
clientProcess certs handle dsthandle dbg sessionStorage _ = do
|
clientProcess creds handle dsthandle dbg sessionStorage _ = do
|
||||||
rng <- RNG.makeSystem
|
rng <- RNG.makeSystem
|
||||||
let logging = if not dbg
|
let logging = if not dbg
|
||||||
then defaultLogging
|
then defaultLogging
|
||||||
|
@ -95,7 +102,7 @@ clientProcess certs handle dsthandle dbg sessionStorage _ = do
|
||||||
let serverstate = defaultParamsServer --maybe id (setSessionManager . MemSessionManager) sessionStorage $ defaultParamsServer
|
let serverstate = defaultParamsServer --maybe id (setSessionManager . MemSessionManager) sessionStorage $ defaultParamsServer
|
||||||
{ pAllowedVersions = [SSL3,TLS10,TLS11,TLS12]
|
{ pAllowedVersions = [SSL3,TLS10,TLS11,TLS12]
|
||||||
, pCiphers = ciphers
|
, pCiphers = ciphers
|
||||||
, pCertificates = certs
|
, pCredentials = creds
|
||||||
, pLogging = logging
|
, pLogging = logging
|
||||||
, pSessionManager = maybe noSessionManager (memSessionManager . MemSessionManager) sessionStorage
|
, pSessionManager = maybe noSessionManager (memSessionManager . MemSessionManager) sessionStorage
|
||||||
}
|
}
|
||||||
|
@ -167,7 +174,6 @@ doClient source destination@(Address a _) flags = do
|
||||||
let clientstate = defaultParamsClient { pConnectVersion = TLS10
|
let clientstate = defaultParamsClient { pConnectVersion = TLS10
|
||||||
, pAllowedVersions = [TLS10,TLS11,TLS12]
|
, pAllowedVersions = [TLS10,TLS11,TLS12]
|
||||||
, pCiphers = ciphers
|
, pCiphers = ciphers
|
||||||
, pCertificates = Nothing
|
|
||||||
, pLogging = logging
|
, pLogging = logging
|
||||||
, onCertificatesRecv = crecv
|
, onCertificatesRecv = crecv
|
||||||
}
|
}
|
||||||
|
@ -190,10 +196,18 @@ doClient source destination@(Address a _) flags = do
|
||||||
return ()
|
return ()
|
||||||
AddrFD _ _ -> error "bad error fd. not implemented"
|
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 :: Address -> Address -> [Flag] -> IO ()
|
||||||
doServer source destination flags = do
|
doServer source destination flags = do
|
||||||
cert <- fileReadCertificateChain $ getCertificate flags
|
creds <- (either (error . show) Credentials . sequence) `fmap` mapM loadCred (zip (getCertificate flags) (getKey flags))
|
||||||
pk <- fileReadPrivateKey $ getKey flags
|
|
||||||
srcaddr <- getAddressDescription source
|
srcaddr <- getAddressDescription source
|
||||||
dstaddr <- getAddressDescription destination
|
dstaddr <- getAddressDescription destination
|
||||||
|
|
||||||
|
@ -211,7 +225,7 @@ doServer source destination flags = do
|
||||||
StunnelSocket dst -> socketToHandle dst ReadWriteMode
|
StunnelSocket dst -> socketToHandle dst ReadWriteMode
|
||||||
|
|
||||||
_ <- forkIO $ finally
|
_ <- 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))
|
(hClose srch >> (when (dsth /= stdout) $ hClose dsth))
|
||||||
return ()
|
return ()
|
||||||
AddrFD _ _ -> error "bad error fd. not implemented"
|
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 (Address _ s) (DestinationType t) = Address t s
|
||||||
accf acc _ = acc
|
accf acc _ = acc
|
||||||
|
|
||||||
getCertificate opts = foldl accf "certificate.pem" opts
|
onNull def l | null l = def
|
||||||
where accf _ (Certificate cert) = cert
|
| otherwise = l
|
||||||
|
|
||||||
|
getCertificate :: [Flag] -> [String]
|
||||||
|
getCertificate opts = reverse $ onNull ["certificate.pem"] $ foldl accf [] opts
|
||||||
|
where accf acc (Certificate cert) = cert:acc
|
||||||
accf acc _ = acc
|
accf acc _ = acc
|
||||||
|
|
||||||
getKey opts = foldl accf "certificate.key" opts
|
getKey opts = reverse $ onNull ["certificate.key"] $ foldl accf [] opts
|
||||||
where accf _ (Key key) = key
|
where accf acc (Key key) = key : acc
|
||||||
accf acc _ = acc
|
accf acc _ = acc
|
||||||
|
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
|
|
|
@ -23,6 +23,7 @@ Executable tls-stunnel
|
||||||
, bytestring
|
, bytestring
|
||||||
, x509-system >= 1.0
|
, x509-system >= 1.0
|
||||||
, cprng-aes >= 0.5.0
|
, cprng-aes >= 0.5.0
|
||||||
|
, crypto-pubkey
|
||||||
, tls >= 1.2 && < 1.3
|
, tls >= 1.2 && < 1.3
|
||||||
, tls-extra >= 0.7.0 && < 0.8
|
, tls-extra >= 0.7.0 && < 0.8
|
||||||
if os(windows)
|
if os(windows)
|
||||||
|
|
Loading…
Reference in a new issue