summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--Hsbot/Config.hs6
-rw-r--r--Hsbot/Core.hs18
-rw-r--r--Hsbot/Types.hs2
-rw-r--r--Hsbot/Utils.hs59
-rw-r--r--hsbot.cabal3
5 files changed, 18 insertions, 70 deletions
diff --git a/Hsbot/Config.hs b/Hsbot/Config.hs
index d51387b..8c85810 100644
--- a/Hsbot/Config.hs
+++ b/Hsbot/Config.hs
@@ -24,12 +24,8 @@ defaultConfig = Config
defaultTLSConfig :: TLSConfig
defaultTLSConfig = TLSConfig
{ sslOn = True
- , sslCert = ""
- , sslKey = ""
, sslVersions = [SSL3, TLS10, TLS11, TLS12]
- , sslCiphers = [ cipher_null_MD5
- , cipher_null_SHA1
- , cipher_AES128_SHA1
+ , sslCiphers = [ cipher_AES128_SHA1
, cipher_AES256_SHA1
, cipher_RC4_128_MD5
, cipher_RC4_128_SHA1
diff --git a/Hsbot/Core.hs b/Hsbot/Core.hs
index 9c72771..11c8732 100644
--- a/Hsbot/Core.hs
+++ b/Hsbot/Core.hs
@@ -8,8 +8,7 @@ import Control.Concurrent
import Control.Exception (IOException, catch)
import Control.Monad.Reader
import Crypto.Random
-import qualified Data.ByteString.Char8 as C
-import qualified Data.ByteString.Lazy as L
+import qualified Data.ByteString.Lazy.UTF8 as L
import qualified Data.Map as M
import Network
import qualified Network.IRC as IRC
@@ -33,15 +32,16 @@ initHsbot config = do
port = configPort config
infoM "Hsbot.Core" $ "Connecting to " ++ hostname -- ++ ":" ++ port
connhdl <- connectTo hostname port
- hSetBuffering connhdl LineBuffering
+ hSetBuffering connhdl NoBuffering
hSetEncoding connhdl utf8
(tls, tlsCtx) <- if sslOn $ configTLS config
then (do
- infoM "Hsbot.Core" "TLS init"
+ infoM "Hsbot.Core" "Initializing TLS communication"
tlsenv <- initTLSEnv (configTLS config)
randomGen <- newGenIO :: IO SystemRandom
sCtx <- client tlsenv randomGen connhdl
- handshake sCtx
+ success <- handshake sCtx
+ unless success $ errorM "Hsbot.Core" "TLS handshake failed" -- TODO: do some usefull error handling
return (Just tlsenv, Just sCtx))
else return (Nothing, Nothing)
return BotEnv { envBotState = botState
@@ -103,7 +103,7 @@ runHsbot = do
botReader :: Handle -> Maybe TLSCtx -> Chan Message -> ThreadId -> IO ()
botReader _ (Just ctx) chan _ = forever $
- fmap L.toChunks (recvData ctx) >>= mapM_ (handleIncomingStr chan . C.unpack) -- TODO exceptions
+ fmap L.toString (recvData ctx) >>= handleIncomingStr chan -- TODO exceptions
botReader handle Nothing chan fatherThreadId = forever $
hGetLine handle `catch` handleIOException >>= handleIncomingStr chan
where
@@ -118,9 +118,9 @@ handleIncomingStr :: Chan Message -> String -> IO ()
handleIncomingStr chan str =
case IRC.decode str of
Just msg -> do
- debugM "Ircd.Reader" $ "<-- " ++ show msg
+ debugM "Hsbot.Reader" $ "<-- " ++ show msg
writeChan chan $ IncomingMsg msg
- Nothing -> debugM "Ircd.Reader" $ "Error: couldn't decode : " ++ str -- TODO: spam control
+ Nothing -> return ()
botLoop :: Env IO ()
botLoop = forever $ do
@@ -134,7 +134,7 @@ botLoop = forever $ do
env <- ask
let connhdl = envHandle env
tlsCtx = envTLSCtx env
- liftIO $ debugM "Ircd.Reader" $ "--> " ++ show outMsg
+ liftIO $ debugM "Hsbot.Loop" $ "--> " ++ show outMsg
liftIO . sendStr connhdl tlsCtx $ IRC.encode outMsg
terminateHsbot :: Env IO ()
diff --git a/Hsbot/Types.hs b/Hsbot/Types.hs
index c7331d3..7e340e3 100644
--- a/Hsbot/Types.hs
+++ b/Hsbot/Types.hs
@@ -79,8 +79,6 @@ data Config = Config
data TLSConfig = TLSConfig
{ sslOn :: Bool
- , sslCert :: String
- , sslKey :: String
, sslVersions :: [Network.TLS.Version]
, sslCiphers :: [Network.TLS.Cipher]
, sslVerify :: Bool
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 }
diff --git a/hsbot.cabal b/hsbot.cabal
index ef9be31..96b9647 100644
--- a/hsbot.cabal
+++ b/hsbot.cabal
@@ -42,8 +42,9 @@ Library
network,
random,
safecopy,
- tls >= 0.6.1,
+ tls >= 0.7.1,
tls-extra >= 0.2.0,
+ utf8-string,
xdg-basedir
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-23 12:24:04 +0000