summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Hsbot.hs30
-rw-r--r--Hsbot/Core.hs35
-rw-r--r--Hsbot/Plugin/Admin.hs4
-rw-r--r--Hsbot/Types.hs2
-rw-r--r--Hsbot/Utils.hs15
-rw-r--r--TODO11
6 files changed, 61 insertions, 36 deletions
diff --git a/Hsbot.hs b/Hsbot.hs
index c02b2e5..08456bf 100644
--- a/Hsbot.hs
+++ b/Hsbot.hs
@@ -5,13 +5,19 @@ module Hsbot
import qualified Config.Dyre as Dyre
import Config.Dyre.Relaunch
import Control.Monad.Reader
+import qualified Data.Map as M
import System.Log.Logger
+import qualified Network.IRC as IRC
import Hsbot.Core
import Hsbot.Types
+import Hsbot.Utils
+
+data State = State (M.Map String String) deriving (Read, Show)
startHsbot :: Config -> IO ()
startHsbot config = do
+ (State buffer) <- restoreTextState $ State M.empty
-- checking for configuration file compilation error
case configErrors config of
Nothing -> return ()
@@ -19,16 +25,34 @@ startHsbot config = do
-- initialization
infoM "Hsbot" "Bot initializations"
hsbotEnv <- initHsbot config
+ -- Handle previous exit state if it exists
+ die_msgs <- case M.lookup "die_msg" buffer of
+ Just dieMsg -> case reads dieMsg :: [(BotStatus, String)] of
+ (status, _):_ -> case status of
+ BotReload reason -> return ["hsbot reloaded, reason : " ++ reason]
+ BotRestart (reason, Just info) -> return ["hsbot restarted, readon : " ++ reason, "additional information: " ++ info]
+ BotRestart (reason, Nothing) -> return ["hsbot restarted, readon : " ++ reason]
+ BotExit -> return []
+ _ -> return ["hsbot die_msg parsing error, this should not happen"]
+ Nothing -> return []
+ let connhdl = envHandle hsbotEnv
+ tlsCtx = envTLSCtx hsbotEnv
+ channels = configChannels config
+ mapM_ (infoM "Hsbot") die_msgs
+ mapM_ (\msg -> mapM_ (\channel -> sendStr hsbotEnv connhdl tlsCtx . IRC.encode $ IRC.Message Nothing "PRIVMSG" [channel, msg]) channels) die_msgs
-- main stuff
infoM "Hsbot" "Bot core starting"
status <- runReaderT runHsbot hsbotEnv
infoM "Hsbot" $ "Bot core exited with status " ++ show status
-- Handling exit signal
case status of
- BotContinue -> startHsbot config -- TODO do something not so dumb about starting over
BotExit -> runReaderT terminateHsbot hsbotEnv
- BotReload -> relaunchMaster Nothing -- TODO relaunchWithTextState (state { stateConfig = config }) Nothing, add a flag that prevent spawning the sockets again
- BotRestart -> relaunchMaster Nothing -- TODO relaunch and kill sockets
+ BotReload reason -> do
+ runReaderT terminateHsbot hsbotEnv
+ relaunchWithTextState (M.singleton "die_msg" . show $ BotReload reason) Nothing -- TODO find a way to properly implement that, then insert necessary information in this MVar
+ BotRestart reason -> do
+ runReaderT terminateHsbot hsbotEnv
+ relaunchWithTextState (M.singleton "die_msg" . show $ BotRestart reason) Nothing
hsbot :: Config -> IO ()
hsbot = Dyre.wrapMain $ Dyre.defaultParams
diff --git a/Hsbot/Core.hs b/Hsbot/Core.hs
index eacbe63..49f5f5d 100644
--- a/Hsbot/Core.hs
+++ b/Hsbot/Core.hs
@@ -70,10 +70,10 @@ runHsbot = do
config = envConfig env
nickname = head $ configNicknames config
channels = configChannels config
- liftIO . sendStr connhdl tlsCtx . IRC.encode $ IRC.nick nickname
- liftIO . sendStr connhdl tlsCtx . IRC.encode $ IRC.user nickname hostname "*" (configRealname config)
+ liftIO . sendStr env connhdl tlsCtx . IRC.encode $ IRC.nick nickname
+ liftIO . sendStr env connhdl tlsCtx . IRC.encode $ IRC.user nickname hostname "*" (configRealname config)
-- Then we join channels
- mapM_ (liftIO . sendStr connhdl tlsCtx . IRC.encode . IRC.joinChan) channels
+ mapM_ (liftIO . sendStr env connhdl tlsCtx . IRC.encode . IRC.joinChan) channels
-- Finally we set the new bot state
asks envBotState >>= liftIO . flip putMVar BotState { botPlugins = M.empty
, botAccess = configAccess config
@@ -88,9 +88,8 @@ runHsbot = do
liftIO $ debugM "Hsbot.Core" "Spawning reader thread"
let connhdl = envHandle env
tlsCtx = envTLSCtx env
- myOwnThreadId <- liftIO myThreadId
chan <- asks envChan
- (liftIO . forkIO $ botReader connhdl tlsCtx chan myOwnThreadId) >>= addThreadIdToQuitMVar
+ (liftIO . forkIO $ botReader env connhdl tlsCtx chan) >>= addThreadIdToQuitMVar
-- Then we spawn all plugins
asks envConfig >>= mapM_ loadPlugin . configPlugins
-- Finally we spawn the main bot loop
@@ -102,18 +101,18 @@ runHsbot = do
-- TODO : kill plugin threads
return code
-botReader :: Handle -> Maybe TLSCtx -> Chan Message -> ThreadId -> IO ()
-botReader _ (Just ctx) chan _ = forever $
- fmap L.toString (recvData ctx) >>= handleIncomingStr chan -- TODO exceptions
-botReader handle Nothing chan fatherThreadId = forever $
- hGetLine handle `catch` handleIOException >>= handleIncomingStr chan
- where
- handleIOException :: IOException -> IO String
- handleIOException ioException = do
- throwTo fatherThreadId ioException
- myId <- myThreadId
- killThread myId
- return ""
+botReader :: BotEnv -> Handle -> Maybe TLSCtx -> Chan Message -> IO ()
+botReader env _ (Just ctx) chan = forever $
+ fmap L.toString (recvData ctx) `catch` handleIOException env "botReader died" >>= handleIncomingStr chan
+botReader env handle Nothing chan = forever $
+ hGetLine handle `catch` handleIOException env "botReader died" >>= handleIncomingStr chan
+
+handleIOException :: BotEnv -> String -> IOException -> IO String
+handleIOException env msg ioException = do
+ runReaderT (setGlobalQuitMVar $ BotRestart (show ioException, Just msg)) env
+ myId <- myThreadId
+ killThread myId
+ return ""
handleIncomingStr :: Chan Message -> String -> IO ()
handleIncomingStr chan str =
@@ -136,7 +135,7 @@ botLoop = forever $ do
let connhdl = envHandle env
tlsCtx = envTLSCtx env
liftIO $ debugM "Hsbot.Loop" $ "--> " ++ show outMsg
- liftIO . sendStr connhdl tlsCtx $ IRC.encode outMsg
+ liftIO . sendStr env connhdl tlsCtx $ IRC.encode outMsg
terminateHsbot :: Env IO ()
terminateHsbot = do
diff --git a/Hsbot/Plugin/Admin.hs b/Hsbot/Plugin/Admin.hs
index 7dba362..cbec152 100644
--- a/Hsbot/Plugin/Admin.hs
+++ b/Hsbot/Plugin/Admin.hs
@@ -33,11 +33,11 @@ theAdmin = forever $ readMsg >>= eval
else answerMsg msg "Only admins can do that."
"restart":"help":_ -> answerMsg msg "restart hsbot, reset the running state to config file directives."
"restart":_ -> lift (hasAccess (IRC.msg_prefix msg) Admin) >>= \right -> if right
- then lift $ setGlobalQuitMVar BotRestart
+ then lift . setGlobalQuitMVar $ BotRestart (getSender msg ++ " request", Nothing)
else answerMsg msg "Only admins can do that."
"reload":"help":_ -> answerMsg msg "reload hsbot, and try merge the new config file directives with actual running state)."
"reload":_ -> lift (hasAccess (IRC.msg_prefix msg) Admin) >>= \right -> if right
- then lift $ setGlobalQuitMVar BotReload
+ then lift . setGlobalQuitMVar . BotReload $ getSender msg ++ " request"
else answerMsg msg "Only admins can do that."
_ -> return ()
| otherwise = return ()
diff --git a/Hsbot/Types.hs b/Hsbot/Types.hs
index 8f84482..7ca9ee0 100644
--- a/Hsbot/Types.hs
+++ b/Hsbot/Types.hs
@@ -66,7 +66,7 @@ data PluginId = PluginId
data Message = IncomingMsg IRC.Message
| OutgoingMsg IRC.Message
-data BotStatus = BotContinue | BotExit | BotReload | BotRestart deriving (Show)
+data BotStatus = BotExit | BotReload String | BotRestart (String, Maybe String) deriving (Read, Show)
-- Config
data Config = Config
diff --git a/Hsbot/Utils.hs b/Hsbot/Utils.hs
index 2a8f58c..043037d 100644
--- a/Hsbot/Utils.hs
+++ b/Hsbot/Utils.hs
@@ -8,12 +8,14 @@ module Hsbot.Utils
) where
import Control.Concurrent
+import Control.Exception (IOException, catch)
import Control.Monad.Reader
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
@@ -47,9 +49,16 @@ hasAccess (Just mask) right = do
| otherwise = False
-- Helpers
-sendStr :: Handle -> Maybe TLSCtx -> String -> IO ()
-sendStr _ (Just ctx) msg = sendData ctx . L.fromString $ msg ++ "\r\n"
-sendStr handle Nothing msg = hPutStrLn handle $ msg ++ "\r\n"
+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
diff --git a/TODO b/TODO
index cb32d7c..92d1f3e 100644
--- a/TODO
+++ b/TODO
@@ -1,7 +1,7 @@
* better hooks?
* add help MVar
* add regexes support in accessList prefix
-
+* exception handling on channel and MVar operations?
@@ -9,7 +9,6 @@
:julien!~julien@ogu21.corp PRIVMSG #shbot :@quote graou snif
-* Improve configuration file errors display
* fork process in background
* add a function to answer by /msg to somebody
@@ -18,16 +17,10 @@
* detect too identical quoting in a raw, or implement quote abort
* find a better way to track who voted for what? - need authentication against the bot
-* write the help module
-* clean the plugin module
-* clean cleaning for the quote module
* write a channel tracking plugin. Write the part chan command
-* add a plugin for admin checks and tracking
+* add a plugin for admin rights checking and user tracking
* add a plugin for timer functionnalities other plugin could subscribe to (the troll plugin).
-* add a "I have stuff to save so don't kill me too hard" status for plugins
-
-* Make the bot auto-reconnect (/!\ admin plugin!)
* Find a way to prevent the socket from being garbage collected, by writing a connection handler for example
* Find a way so that not a single message/information would be lost in the case of a reboot