1 files changed, 32 insertions, 56 deletions

diff --git a/Hsbot/Utils.hs b/Hsbot/Utils.hs
index 6eec5c4..2ea1a49 100644
--- a/Hsbot/Utils.hs
+++ b/Hsbot/Utils.hs
@@ -1,25 +1,21 @@
 module Hsbot.Utils
     ( addThreadIdToQuitMVar
     , delThreadIdFromQuitMVar
+    , hasAccess
     , initTLSEnv
-    , readCertificate
-    , readPrivateKey
     , sendStr
     , setGlobalQuitMVar
     ) where
 
 import Control.Concurrent
+import Control.Exception (IOException, catch)
 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 Data.List
-import Data.Maybe
+import Control.Monad.State
+import qualified Data.ByteString.Lazy.UTF8 as L
+import qualified Data.List as L
+import qualified Network.IRC as IRC
 import Network.TLS
+import Prelude hiding (catch)
 import System.IO
 
 import Hsbot.Types
@@ -33,61 +29,41 @@ addThreadIdToQuitMVar thrId = do
 delThreadIdFromQuitMVar :: ThreadId -> Env IO ()
 delThreadIdFromQuitMVar thrId = do
     threadIdsMv <- asks envThreadIdsMv
-    liftIO $ modifyMVar_ threadIdsMv (return . delete thrId)
+    liftIO $ modifyMVar_ threadIdsMv (return . L.delete thrId)
 
 setGlobalQuitMVar :: BotStatus -> Env IO ()
 setGlobalQuitMVar status = do
     quitMv <- asks envQuitMv
     liftIO $ putMVar quitMv status
 
+-- Access rights
+hasAccess :: Maybe IRC.Prefix -> AccessRight -> Env IO Bool
+hasAccess Nothing _ = return False
+hasAccess (Just mask) right = do
+    asks envBotState >>= liftIO . readMVar >>= evalStateT (fmap (any accessMatch) (gets botAccess))
+  where
+    accessMatch :: AccessList -> Bool
+    accessMatch (AccessList amask arights)
+      | mask == amask = or [Admin `L.elem` arights, right `L.elem` arights]
+      | otherwise = False
+
 -- 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 :: BotEnv -> Handle -> Maybe TLSCtx -> String -> IO ()
+sendStr env _ (Just ctx) msg = sendData ctx (L.fromString $ msg ++ "\r\n") `catch` handleIOException env ("sendStr " ++ msg)
+sendStr env handle Nothing msg = hPutStrLn handle (msg ++ "\r\n") `catch` handleIOException env ("sendStr " ++ msg)
+
+handleIOException :: BotEnv -> String -> IOException -> IO ()
+handleIOException env msg ioException = do
+    runReaderT (setGlobalQuitMVar $ BotRestart (show ioException, Just msg)) env
+    myId <- myThreadId
+    killThread myId
+    return ()
 
 -- 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 }