Archived
1
0
Fork 0

Added signal handling and a better semantic for bot status.

This commit is contained in:
Julien Dessaux 2010-05-29 22:38:18 +02:00
parent 57bec4921b
commit 9dda7dc1b9
4 changed files with 39 additions and 10 deletions

View file

@ -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" }