diff options
Diffstat (limited to '')
| -rw-r--r-- | Hsbot/Core.hs | 8 | ||||
| -rw-r--r-- | Hsbot/Irc/Core.hs | 17 | ||||
| -rw-r--r-- | Hsbot/Irc/Plugin.hs | 22 | ||||
| -rw-r--r-- | Hsbot/Irc/Types.hs | 3 | ||||
| -rw-r--r-- | Hsbot/Plugin.hs | 52 | ||||
| -rw-r--r-- | TODO | 1 |
6 files changed, 70 insertions, 33 deletions
diff --git a/Hsbot/Core.hs b/Hsbot/Core.hs index f98fece..fac9f8e 100644 --- a/Hsbot/Core.hs +++ b/Hsbot/Core.hs @@ -31,9 +31,11 @@ hsbot config = do , 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 botState' resumeData + then resumeHsbot resumeData else return () where runLoop :: BotState -> IO (BotStatus, BotState) @@ -43,8 +45,8 @@ hsbot config = do BotContinue -> runLoop botState' _ -> return (status, botState') -resumeHsbot :: BotState -> BotResumeData -> IO () -resumeHsbot botState resumeData = do +resumeHsbot :: BotResumeData -> IO () +resumeHsbot resumeData = do print resumeData -- | Run the bot main loop diff --git a/Hsbot/Irc/Core.hs b/Hsbot/Irc/Core.hs index 2fb8386..229fef8 100644 --- a/Hsbot/Irc/Core.hs +++ b/Hsbot/Irc/Core.hs @@ -3,7 +3,7 @@ module Hsbot.Irc.Core ) where import Control.Concurrent -import Control.Exception (IOException, catch) +import Control.Exception (AsyncException, Handler (..), IOException, catch, catches) import Control.Monad.State import qualified Data.Map as M import Data.Maybe (fromMaybe) @@ -34,7 +34,7 @@ startIrcbot config masterChan myChan = do putStrLn "[IrcBot] Spawning reader threads..." myOwnThreadId <- myThreadId readerThreadId <- forkIO $ ircBotReader handle chan myOwnThreadId - masterReaderThreadId <- forkIO $ ircBotMasterReader masterChan chan + masterReaderThreadId <- forkIO $ ircBotMasterReader myChan chan putStrLn "[IrcBot] Initializing server connection..." let ircServerState = IrcServerState { ircServerId = ircConfigAddress config , ircServerChannels = [] @@ -46,18 +46,23 @@ startIrcbot config masterChan myChan = do , ircBotCommands = M.empty , ircBotChan = chan , ircBotMasterChan = masterChan - , ircBotMyChan = myChan , ircBotServerState = ircServerState , ircBotHandle = handle , ircBotConfig = config - , ircBotReaderThreadId = readerThreadId - , ircBotMasterReaderThreadId = masterReaderThreadId , ircBotResumeData = M.singleton "HANDLE" (show fd) } ircBotState' <- execStateT (initBotServerConnection config) ircBotState putStrLn "[IrcBot] Spawning plugins..." ircBotState'' <- execStateT spawnIrcPlugins ircBotState' putStrLn "[IrcBot] Entering Core loop... " - (evalStateT ircBotLoop ircBotState'') `catch` (\(_ :: IOException) -> return ()) + ircBotState''' <- (execStateT ircBotLoop ircBotState'') `catches` [ Handler (\ (_ :: IOException) -> return (ircBotState'')) + , Handler (\ (_ :: AsyncException) -> return (ircBotState'')) ] + putStrLn "[IrcBot] Killing reader threads..." + killThread readerThreadId + killThread masterReaderThreadId + putStrLn "[IrcBot] Killing active plugins... " + let resumeData = ircBotResumeData ircBotState''' + ircPlugins = read (fromMaybe [] (M.lookup "PLUGINS" resumeData)) :: [String] + evalStateT (mapM_ killIrcPlugin ircPlugins) ircBotState''' return () --resumeIrcBot diff --git a/Hsbot/Irc/Plugin.hs b/Hsbot/Irc/Plugin.hs index d972db2..28026aa 100644 --- a/Hsbot/Irc/Plugin.hs +++ b/Hsbot/Irc/Plugin.hs @@ -1,6 +1,7 @@ module Hsbot.Irc.Plugin ( IrcPlugin , IrcPluginState (..) + , killIrcPlugin , listPlugins , loadIrcPlugin , sendToPlugin @@ -72,16 +73,23 @@ listPlugins originalRequest dest = do -- | Unloads a plugin unloadIrcPlugin :: String -> IrcBot () unloadIrcPlugin name = do + killIrcPlugin name ircbot <- get - let oldPlugins = ircBotPlugins ircbot - oldResumeData = ircBotResumeData ircbot + let oldResumeData = ircBotResumeData ircbot + newPlugins = M.keys $ ircBotPlugins ircbot + newResumeData = M.insert "PLUGINS" (show newPlugins) oldResumeData + put $ ircbot { ircBotResumeData = newResumeData } + +-- | kills a plugin +killIrcPlugin :: String -> IrcBot () +killIrcPlugin name = do + ircbot <- get + let oldPlugins = ircBotPlugins ircbot -- We check if the plugin exists case M.lookup name oldPlugins of Just (_, threadId) -> do - let newPlugins = M.delete name oldPlugins - newResumeData = M.insert "PLUGINS" (show $ M.keys newPlugins) oldResumeData + let newPlugins = M.delete name oldPlugins liftIO $ throwTo threadId UserInterrupt - put $ ircbot { ircBotPlugins = newPlugins - , ircBotResumeData = newResumeData } - Nothing -> return () + put $ ircbot { ircBotPlugins = newPlugins } + Nothing -> return () diff --git a/Hsbot/Irc/Types.hs b/Hsbot/Irc/Types.hs index c9be251..fe70ea4 100644 --- a/Hsbot/Irc/Types.hs +++ b/Hsbot/Irc/Types.hs @@ -26,12 +26,9 @@ data IrcBotState = IrcBotState , ircBotCommands :: M.Map String [String] -- Loaded plugins , ircBotChan :: Chan IrcBotMsg -- The IrcBot's communication channel , ircBotMasterChan :: Chan BotMsg -- The Hsbot communication channel - , ircBotMyChan :: Chan BotMsg -- The Hsbot communication channel , ircBotServerState :: IrcServerState -- The state of the IrcServer , ircBotHandle :: Handle -- The server's socket/handle , ircBotConfig :: IrcConfig -- The starting configuration - , ircBotReaderThreadId :: ThreadId -- the thread that process inputs from the socket - , ircBotMasterReaderThreadId :: ThreadId -- the thread that process inputs from the master bot , ircBotResumeData :: ResumeData -- the necessary data to resume the bot's operations on reboot } diff --git a/Hsbot/Plugin.hs b/Hsbot/Plugin.hs index aafa495..10c59af 100644 --- a/Hsbot/Plugin.hs +++ b/Hsbot/Plugin.hs @@ -1,11 +1,16 @@ module Hsbot.Plugin - ( spawnIrcPlugins + ( killPlugin + , spawnIrcPlugins + , spawnIrcPlugin + , unloadPlugin ) where import Control.Concurrent import Control.Concurrent.Chan () +import Control.Exception import Control.Monad.State import qualified Data.Map as M +import Prelude hiding (catch) import Hsbot.Config import Hsbot.Irc.Config @@ -17,16 +22,37 @@ spawnIrcPlugins :: Bot () spawnIrcPlugins = do config <- gets botConfig mapM_ (spawnIrcPlugin) (ircConfigs config) - where - spawnIrcPlugin :: IrcConfig -> Bot () - spawnIrcPlugin config = do - bot <- get - let chan = botChan bot - pchan <- liftIO (newChan :: IO (Chan BotMsg)) - threadId <- liftIO $ forkIO (startIrcbot config chan pchan) - let plugin = PluginState { pluginName = ircConfigName config - , pluginChan = pchan - , pluginHandles = M.empty } - plugins = botPlugins bot - put $ bot { botPlugins = M.insert (pluginName plugin) (plugin, threadId) plugins } + +-- | spawns a single irc plugin +spawnIrcPlugin :: IrcConfig -> Bot () +spawnIrcPlugin config = do + bot <- get + let chan = botChan bot + pchan <- liftIO (newChan :: IO (Chan BotMsg)) + threadId <- liftIO $ forkIO (startIrcbot config chan pchan) + let plugin = PluginState { pluginName = ircConfigName config + , pluginChan = pchan + , pluginHandles = M.empty } + plugins = botPlugins bot + put $ bot { botPlugins = M.insert (pluginName plugin) (plugin, threadId) plugins } + +-- | Unloads a plugin +unloadPlugin :: String -> Bot () +unloadPlugin name = do + killPlugin name + resumeData <- gets botResumeData + liftIO $ modifyMVar_ resumeData (\oldData -> return $ M.delete name oldData) + +-- | kills a plugin +killPlugin :: String -> Bot () +killPlugin name = do + bot <- get + let oldPlugins = botPlugins bot + -- We check if the plugin exists + case M.lookup name oldPlugins of + Just (_, threadId) -> do + let newPlugins = M.delete name oldPlugins + liftIO $ throwTo threadId UserInterrupt + put $ bot { botPlugins = newPlugins } + Nothing -> return () @@ -1,6 +1,5 @@ :julien!~julien@ogu21.corp PRIVMSG #shbot :@quote graou snif -* Handle clean termination of all thread on reboot * Find a way to handle bot reloading threw exec * Find a way to cleanly handle termination/reboot requests (signals, IOExceptions, plugins' requests) |