blob: b6c4d9cce411461a41f557731b6a9745875dd911 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
|
module Hsbot.Core
( hsbot
) where
import Control.Concurrent.Chan
import Control.Concurrent.MVar
import Control.Exception
import Control.Monad.State
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
import Hsbot.Plugin
import Hsbot.Types
-- | Bot's main entry point
hsbot :: [BotConfig] -> IO ()
hsbot config = do
startTime <- getCurrentTime
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
, botChan = chan
, botConfig = config
, botResumeData = mvar }
putStrLn "[Hsbot] Entering main loop... "
(status, botState') <- runLoop botState
putStrLn "[Hsbot] Killing active plugins... "
resumeData <- takeMVar mvar
evalStateT (mapM_ killPlugin $ M.keys resumeData) botState'
if status == BotReboot
then resumeHsbot resumeData
else return ()
where
runLoop :: BotState -> IO (BotStatus, BotState)
runLoop botState = do
(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')
resumeHsbot :: BotResumeData -> IO ()
resumeHsbot resumeData = do
print resumeData
-- | Run the bot main loop
botCore :: Bot (BotStatus)
botCore = do
chan <- gets botChan
msg <- liftIO $ readChan chan
case msg of
IntMsg intMsg -> processInternalMessage intMsg
UpdMsg updMsg -> processUpdateMessage updMsg
RebMsg rebMsg -> processRebootMessage rebMsg
ExiMsg exiMsg -> processExitMessage exiMsg
-- | Process an update command
processUpdateMessage :: ResumeMsg -> Bot (BotStatus)
processUpdateMessage msg = do
resumeData <- gets botResumeData
let from = resMsgFrom msg
stuff = resMsgData msg
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" }
|
