Added signal handling and a better semantic for bot status.

1 files changed, 17 insertions, 4 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" }
+