diff options
Diffstat (limited to 'Hsbot/Irc')
| -rw-r--r-- | Hsbot/Irc/Command.hs | 12 | ||||
| -rw-r--r-- | Hsbot/Irc/Core.hs | 29 | ||||
| -rw-r--r-- | Hsbot/Irc/Plugin/Core.hs | 9 |
3 files changed, 36 insertions, 14 deletions
diff --git a/Hsbot/Irc/Command.hs b/Hsbot/Irc/Command.hs index ef1ef27..242e12d 100644 --- a/Hsbot/Irc/Command.hs +++ b/Hsbot/Irc/Command.hs @@ -34,7 +34,7 @@ unregisterCommand cmd pluginName' = do put $ ircBot { ircBotCommands = newCmds } -- | Processes an internal command -processInternalCommand :: IrcBotMsg -> IrcBot () +processInternalCommand :: IrcBotMsg -> IrcBot (Bool) processInternalCommand (IntIrcCmd ircCmd) | ircCmdTo ircCmd == "CORE" = processCoreCommand ircCmd | otherwise = do @@ -42,21 +42,23 @@ processInternalCommand (IntIrcCmd ircCmd) case M.lookup (ircCmdTo ircCmd) plugins of Just (plugin, _) -> sendToPlugin (IntIrcCmd ircCmd) plugin Nothing -> return () -processInternalCommand _ = return () + return False +processInternalCommand _ = return (False) -- | Processes a core command -processCoreCommand :: IrcCmd -> IrcBot () +processCoreCommand :: IrcCmd -> IrcBot (Bool) processCoreCommand ircCmd = do let command' = ircCmdCmd ircCmd originalRequest = ircCmdBotMsg ircCmd case command' of "LIST" -> listPlugins originalRequest (ircCmdFrom ircCmd) "LOAD" -> loadIrcPlugin $ ircCmdMsg ircCmd - "UNLOAD" -> unloadIrcPlugin $ ircCmdMsg ircCmd - "UPDATE" -> processUpdateCommand ircCmd "REGISTER" -> registerCommand (ircCmdMsg ircCmd) (ircCmdFrom ircCmd) + "UNLOAD" -> unloadIrcPlugin $ ircCmdMsg ircCmd "UNREGISTER" -> unregisterCommand (ircCmdMsg ircCmd) (ircCmdFrom ircCmd) + "UPDATE" -> processUpdateCommand ircCmd _ -> return () + return $ command' == "REBOOT" -- | Process an update command processUpdateCommand :: IrcCmd -> IrcBot () diff --git a/Hsbot/Irc/Core.hs b/Hsbot/Irc/Core.hs index 936ced6..b1aee02 100644 --- a/Hsbot/Irc/Core.hs +++ b/Hsbot/Irc/Core.hs @@ -57,7 +57,7 @@ startIrcbot config masterChan myChan = do putStrLn "[IrcBot] Spawning plugins..." ircBotState'' <- execStateT spawnIrcPlugins ircBotState' putStrLn "[IrcBot] Entering Core loop... " - _ <- (execStateT ircBotLoop ircBotState'') `catch` (\(_ :: IOException) -> return (ircBotState'')) + (evalStateT ircBotLoop ircBotState'') `catch` (\(_ :: IOException) -> return ()) return () --resumeIrcBot @@ -103,8 +103,11 @@ ircBotLoop = forever $ do InIrcMsg inIrcMsg -> dispatchMessage $ InIrcMsg inIrcMsg OutIrcMsg outIrcMsg -> sendThisMessage outIrcMsg IntIrcCmd intIrcCmd -> do - processInternalCommand $ IntIrcCmd intIrcCmd + reboot <- processInternalCommand $ IntIrcCmd intIrcCmd reportUpdate + if reboot + then processRebootCommand + else return () where sendThisMessage :: IrcMsg -> IrcBot () sendThisMessage outputMsg = do @@ -142,10 +145,22 @@ reportUpdate :: IrcBot () reportUpdate = do ircbot <- get let masterChan = ircBotMasterChan ircbot - msg = IntMsg $ Msg { msgType = "UPDATE" - , msgFrom = ircConfigName $ ircBotConfig ircbot - , msgTo = "CORE" - , msgCmd = show $ ircBotResumeData ircbot - } + msg = IntMsg $ Msg { msgType = "UPDATE" + , msgFrom = ircConfigName $ ircBotConfig ircbot + , msgTo = "CORE" + , msgStuff = show $ ircBotResumeData ircbot + } + liftIO $ writeChan masterChan msg + +-- | Process a reboot command +processRebootCommand :: IrcBot () +processRebootCommand = do + ircbot <- get + let masterChan = ircBotMasterChan ircbot + msg = IntMsg $ Msg { msgType = "REBOOT" + , msgFrom = ircConfigName $ ircBotConfig ircbot + , msgTo = "CORE" + , msgStuff = show $ ircBotResumeData ircbot + } liftIO $ writeChan masterChan msg diff --git a/Hsbot/Irc/Plugin/Core.hs b/Hsbot/Irc/Plugin/Core.hs index 0297e2c..114ced8 100644 --- a/Hsbot/Irc/Plugin/Core.hs +++ b/Hsbot/Irc/Plugin/Core.hs @@ -16,9 +16,9 @@ ircBotPluginCore myChan masterChan = do let plugin = IrcPluginState { ircPluginName = "Core" , ircPluginChan = myChan , ircPluginMasterChan = masterChan } - evalStateT (mapM_ sendRegisterCommand ["list", "load", "reload", "unload"]) plugin + evalStateT (mapM_ sendRegisterCommand ["list", "load", "reload", "unload", "reboot"]) plugin plugin' <- (execStateT run plugin) `catch` (\(_ :: AsyncException) -> return plugin) - evalStateT (mapM_ sendUnregisterCommand ["list", "load", "reload", "unload"]) plugin' + evalStateT (mapM_ sendUnregisterCommand ["list", "load", "reload", "unload", "reboot"]) plugin' -- | The IrcPlugin monad main function run :: IrcPlugin () @@ -36,6 +36,7 @@ run = forever $ do "load" -> loadPlugin $ tail stuff "reload" -> reloadPlugin $ tail stuff "unload" -> unloadPlugin $ tail stuff + "reboot" -> rebootBot $ tail stuff _ -> return () -- TODO : help message "ANSWER" -> let stuff = ircCmdMsg intCmd in answerMsg request ("Loaded plugins : " ++ stuff) @@ -59,3 +60,7 @@ reloadPlugin pluginNames = mapM_ (sendCommand "RELOAD" "CORE") pluginNames unloadPlugin :: [String] -> IrcPlugin () unloadPlugin pluginNames = mapM_ (sendCommand "UNLOAD" "CORE") pluginNames +-- | The reboot command +rebootBot :: [String] -> IrcPlugin () +rebootBot stuff = sendCommand "REBOOT" "CORE" $ unwords stuff + |