From b666e543d0ae03f79ca8b8527c099ca6320f27b0 Mon Sep 17 00:00:00 2001
From: Julien Dessaux
Date: Mon, 11 Jul 2011 22:35:41 +0200
Subject: Fixed TLS client implementation

---
 Hsbot/Utils.hs | 59 ++++++----------------------------------------------------
 1 file changed, 6 insertions(+), 53 deletions(-)

(limited to 'Hsbot/Utils.hs')

diff --git a/Hsbot/Utils.hs b/Hsbot/Utils.hs
index 6eec5c4..e56e9f7 100644
--- a/Hsbot/Utils.hs
+++ b/Hsbot/Utils.hs
@@ -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 }
 
-- 
cgit v1.2.3