summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Hsbot/Core.hs21
-rw-r--r--Hsbot/Message.hs15
-rw-r--r--Hsbot/Types.hs12
-rw-r--r--TODO1
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)
diff --git a/TODO b/TODO
index 13a3aba..c457ed4 100644
--- a/TODO
+++ b/TODO
@@ -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