Archived
1
0
Fork 0

Fixed TLS client implementation

This commit is contained in:
Julien Dessaux 2011-07-11 22:35:41 +02:00
parent 62a4220ce0
commit b666e543d0
5 changed files with 18 additions and 70 deletions

View file

@ -2,23 +2,14 @@ module Hsbot.Utils
( addThreadIdToQuitMVar
, delThreadIdFromQuitMVar
, initTLSEnv
, readCertificate
, readPrivateKey
, sendStr
, setGlobalQuitMVar
) where
import Control.Concurrent
import Control.Monad.Reader
import qualified Crypto.Cipher.RSA as RSA
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as C
import qualified Data.ByteString.Lazy as L
import qualified Data.Certificate.KeyRSA as KeyRSA
import Data.Certificate.PEM
import Data.Certificate.X509
import qualified Data.ByteString.Lazy.UTF8 as L
import Data.List
import Data.Maybe
import Network.TLS
import System.IO
@ -42,52 +33,14 @@ setGlobalQuitMVar status = do
-- Helpers
sendStr :: Handle -> Maybe TLSCtx -> String -> IO ()
sendStr _ (Just ctx) msg = sendData ctx $ L.fromChunks [C.pack msg]
sendStr handle Nothing msg = hPutStrLn handle msg
sendStr _ (Just ctx) msg = sendData ctx . L.fromString $ msg ++ "\r\n"
sendStr handle Nothing msg = hPutStrLn handle $ msg ++ "\r\n"
-- TLS utils
initTLSEnv :: TLSConfig -> IO TLSParams
initTLSEnv ssl = do
let certFile = sslCert ssl
keyFile = sslKey ssl
versions = sslVersions ssl
let versions = sslVersions ssl
ciphers = sslCiphers ssl
verify = sslVerify ssl
-- TODO : exception on loading keys
cert <- readCertificate certFile
pk <- readPrivateKey keyFile
return $ defaultParams { pConnectVersion = TLS12
, pAllowedVersions = versions
, pCiphers = ciphers
, pWantClientCert = verify
, pCertificates = [(cert, Just pk)] }
readCertificate :: FilePath -> IO X509
readCertificate filepath = do
content <- B.readFile filepath
let certdata = fromMaybe (error "no valid certificate section") $ parsePEMCert content
cert = case decodeCertificate $ L.fromChunks [certdata] of
Left err -> error ("cannot decode certificate: " ++ err)
Right x -> x
return cert
readPrivateKey :: FilePath -> IO PrivateKey
readPrivateKey filepath = do
content <- B.readFile filepath
let pkdata = case parsePEMKeyRSA content of
Nothing -> error "no valid RSA key section"
Just x -> L.fromChunks [x]
let pk = case KeyRSA.decodePrivate pkdata of
Left err -> error ("cannot decode key: " ++ err)
Right x -> PrivRSA RSA.PrivateKey
{ RSA.private_sz = fromIntegral $ KeyRSA.lenmodulus x
, RSA.private_n = KeyRSA.modulus x
, RSA.private_d = KeyRSA.private_exponant x
, RSA.private_p = KeyRSA.p1 x
, RSA.private_q = KeyRSA.p2 x
, RSA.private_dP = KeyRSA.exp1 x
, RSA.private_dQ = KeyRSA.exp2 x
, RSA.private_qinv = KeyRSA.coef x
}
return pk
return $ defaultParams { pAllowedVersions = versions
, pCiphers = ciphers }