diff options
| -rw-r--r-- | Hsbot/Core.hs | 21 | ||||
| -rw-r--r-- | Hsbot/Message.hs | 15 | ||||
| -rw-r--r-- | Hsbot/Types.hs | 12 | ||||
| -rw-r--r-- | TODO | 1 |
4 files changed, 39 insertions, 10 deletions
diff --git a/Hsbot/Core.hs b/Hsbot/Core.hs index 025e0c5..b6c4d9c 100644 --- a/Hsbot/Core.hs +++ b/Hsbot/Core.hs @@ -10,6 +10,7 @@ import qualified Data.Map as M import Data.Time import Prelude hiding (catch) import System.IO() +import System.Posix.Signals import Hsbot.Config import Hsbot.Message @@ -23,6 +24,9 @@ hsbot config = do putStrLn "[Hsbot] Opening communication channel... " chan <- newChan :: IO (Chan BotMsg) mvar <- newMVar M.empty :: IO (MVar BotResumeData) + putStrLn "[Hsbot] Installing signal handlers... " + _ <- installHandler sigHUP (Catch $ sigHupHandler chan) Nothing + _ <- installHandler sigTERM (Catch $ sigTermHandler chan) Nothing putStrLn "[Hsbot] Spawning IrcBot plugins... " botState <- execStateT spawnPlugins BotState { botStartTime = startTime , botPlugins = M.empty @@ -40,7 +44,8 @@ hsbot config = do where runLoop :: BotState -> IO (BotStatus, BotState) runLoop botState = do - (status, botState') <- (runStateT botCore botState) `catch` (\(_ :: IOException) -> return (BotExit, botState)) + (status, botState') <- (runStateT botCore botState) `catches` [ Handler (\ (_ :: IOException) -> return (BotExit, botState)) + , Handler (\ (_ :: AsyncException) -> return (BotExit, botState)) ] case status of BotContinue -> runLoop botState' _ -> return (status, botState') @@ -55,10 +60,10 @@ botCore = do chan <- gets botChan msg <- liftIO $ readChan chan case msg of - InMsg _ -> return BotContinue - OutMsg _ -> return BotContinue - IntMsg intMsg -> processInternalMessage $ IntMsg intMsg + IntMsg intMsg -> processInternalMessage intMsg UpdMsg updMsg -> processUpdateMessage updMsg + RebMsg rebMsg -> processRebootMessage rebMsg + ExiMsg exiMsg -> processExitMessage exiMsg -- | Process an update command processUpdateMessage :: ResumeMsg -> Bot (BotStatus) @@ -69,3 +74,11 @@ processUpdateMessage msg = do liftIO $ modifyMVar_ resumeData (\oldData -> return $ M.insert from stuff oldData) return BotContinue +-- | signals handlers +sigHupHandler :: Chan BotMsg -> IO () +sigHupHandler chan = writeChan chan $ RebMsg RebootMsg { rebMsgFrom = "HUP handler" } + +-- | signals handlers +sigTermHandler :: Chan BotMsg -> IO () +sigTermHandler chan = writeChan chan $ ExiMsg ExitMsg { exiMsgFrom = "TERM handler" } + diff --git a/Hsbot/Message.hs b/Hsbot/Message.hs index f38438f..933394b 100644 --- a/Hsbot/Message.hs +++ b/Hsbot/Message.hs @@ -1,5 +1,7 @@ module Hsbot.Message ( processInternalMessage + , processRebootMessage + , processExitMessage ) where import Control.Monad.State @@ -9,16 +11,15 @@ import Hsbot.PluginUtils import Hsbot.Types -- | Processes an internal message -processInternalMessage :: BotMsg -> Bot (BotStatus) -processInternalMessage (IntMsg msg) +processInternalMessage :: Msg -> Bot (BotStatus) +processInternalMessage msg | msgTo msg == "CORE" = processCoreMessage msg | otherwise = do plugins <- gets botPlugins case M.lookup (msgTo msg) plugins of - Just (plugin, _) -> sendToPlugin (IntMsg msg) plugin + Just (plugin, _, _) -> sendToPlugin (IntMsg msg) plugin Nothing -> return () return BotContinue -processInternalMessage _ = return BotContinue processCoreMessage :: Msg -> Bot (BotStatus) processCoreMessage msg = do @@ -26,3 +27,9 @@ processCoreMessage msg = do "REBOOT" -> return BotReboot _ -> return BotContinue +processRebootMessage :: RebootMsg -> Bot (BotStatus) +processRebootMessage _ = return BotReboot -- TODO : check who is sending that to us + +processExitMessage :: ExitMsg -> Bot (BotStatus) +processExitMessage _ = return BotExit -- TODO : check who is sending that to us + diff --git a/Hsbot/Types.hs b/Hsbot/Types.hs index 4052e58..009390d 100644 --- a/Hsbot/Types.hs +++ b/Hsbot/Types.hs @@ -4,9 +4,11 @@ module Hsbot.Types , BotResumeData , BotState (..) , BotStatus (..) + , ExitMsg (..) , Msg (..) , Plugin , PluginState (..) + , RebootMsg (..) , ResumeData , ResumeMsg (..) ) where @@ -61,5 +63,13 @@ data ResumeMsg = ResMsg , resMsgData :: ResumeData } deriving (Show) -data BotMsg = InMsg Msg | OutMsg Msg | IntMsg Msg | UpdMsg ResumeMsg deriving (Show) +data RebootMsg = RebootMsg + { rebMsgFrom :: String + } deriving (Show) + +data ExitMsg = ExitMsg + { exiMsgFrom :: String + } deriving (Show) + +data BotMsg = IntMsg Msg | UpdMsg ResumeMsg | RebMsg RebootMsg | ExiMsg ExitMsg deriving (Show) @@ -1,7 +1,6 @@ :julien!~julien@ogu21.corp PRIVMSG #shbot :@quote graou snif * Find a way to handle bot reloading threw exec -* Find a way to cleanly handle termination/reboot requests (signals, IOExceptions, plugins' requests) * write the vote system for the quote module * only the quote reporter should be able to edit it |