From d97177ce3b392f80e36a93ca41ca1426b0220733 Mon Sep 17 00:00:00 2001 From: Julien Dessaux Date: Thu, 10 Jun 2010 23:30:09 +0200 Subject: Wrote most of the resume code for the core and the irc plugin. --- Hsbot/Core.hs | 29 ++++++++++++++++++----------- Hsbot/Irc/Core.hs | 33 +++++++++++++++++++++------------ Hsbot/Irc/Types.hs | 4 +--- Hsbot/Plugin.hs | 18 +++++++++++------- 4 files changed, 51 insertions(+), 33 deletions(-) (limited to 'Hsbot') diff --git a/Hsbot/Core.hs b/Hsbot/Core.hs index b6c4d9c..dad965d 100644 --- a/Hsbot/Core.hs +++ b/Hsbot/Core.hs @@ -18,12 +18,23 @@ import Hsbot.Plugin import Hsbot.Types -- | Bot's main entry point -hsbot :: [BotConfig] -> IO () -hsbot config = do - startTime <- getCurrentTime +hsbot :: [BotConfig] -> Maybe String -> IO () +hsbot config txtResumeData= do + let resumeData = case txtResumeData of + Just txtData -> read txtData :: BotResumeData -- TODO : catch exception + Nothing -> M.empty :: BotResumeData + startTime <- case M.lookup "HSBOT" resumeData of + Just hsbotData -> do + case M.lookup "STARTTIME" hsbotData of + Just txtStartTime -> do + let gotStartTime = read txtStartTime :: UTCTime + return gotStartTime + Nothing -> getCurrentTime + Nothing -> getCurrentTime + let resumeData' = M.insert "HSBOT" (M.singleton "STARTTIME" $ show startTime) resumeData putStrLn "[Hsbot] Opening communication channel... " chan <- newChan :: IO (Chan BotMsg) - mvar <- newMVar M.empty :: IO (MVar BotResumeData) + mvar <- newMVar resumeData' :: IO (MVar BotResumeData) putStrLn "[Hsbot] Installing signal handlers... " _ <- installHandler sigHUP (Catch $ sigHupHandler chan) Nothing _ <- installHandler sigTERM (Catch $ sigTermHandler chan) Nothing @@ -36,10 +47,10 @@ hsbot config = do putStrLn "[Hsbot] Entering main loop... " (status, botState') <- runLoop botState putStrLn "[Hsbot] Killing active plugins... " - resumeData <- takeMVar mvar - evalStateT (mapM_ killPlugin $ M.keys resumeData) botState' + newResumeData <- takeMVar mvar + evalStateT (mapM_ killPlugin $ M.keys newResumeData) botState' if status == BotReboot - then resumeHsbot resumeData + then hsbot config (Just $ show newResumeData) -- TODO : exec on the hsbot launcher with the reload string else return () where runLoop :: BotState -> IO (BotStatus, BotState) @@ -50,10 +61,6 @@ hsbot config = do BotContinue -> runLoop botState' _ -> return (status, botState') -resumeHsbot :: BotResumeData -> IO () -resumeHsbot resumeData = do - print resumeData - -- | Run the bot main loop botCore :: Bot (BotStatus) botCore = do diff --git a/Hsbot/Irc/Core.hs b/Hsbot/Irc/Core.hs index 51032a8..d65e975 100644 --- a/Hsbot/Irc/Core.hs +++ b/Hsbot/Irc/Core.hs @@ -7,11 +7,11 @@ import Control.Exception (AsyncException, Handler (..), IOException, catch, catc import Control.Monad.State import qualified Data.Map as M import Data.Maybe (fromMaybe) -import Data.Time import Network import Prelude hiding (catch) import System.IO -import System.Posix.IO (handleToFd) +import System.Posix.IO (fdToHandle, handleToFd) +import System.Posix.Types (Fd) import Hsbot.Irc.Command import Hsbot.Irc.Config @@ -22,14 +22,24 @@ import Hsbot.Irc.Types import Hsbot.Types -- | IrcBot's main entry point -startIrcbot :: IrcConfig -> Chan BotMsg -> Chan BotMsg -> IO () -startIrcbot config masterChan myChan = do - startTime <- getCurrentTime +startIrcbot :: IrcConfig -> Chan BotMsg -> Chan BotMsg -> Maybe String -> IO () +startIrcbot config masterChan myChan txtResumeData = do + let resumeData = case txtResumeData of + Just txtData -> read txtData :: ResumeData -- TODO : catch exception + Nothing -> M.empty :: ResumeData + print resumeData putStrLn "[IrcBot] Opening communication channel... " chan <- newChan :: IO (Chan IrcBotMsg) - putStrLn $ concat ["[IrcBot] Connecting to ", ircConfigAddress config, "... "] - handle <- connectTo (ircConfigAddress config) (ircConfigPort config) - hSetBuffering handle NoBuffering + handle <- case M.lookup "HANDLE" resumeData of + Just txtFd -> do + let fd = read txtFd :: Fd + fdToHandle fd + Nothing -> do + putStrLn $ concat ["[IrcBot] Connecting to ", ircConfigAddress config, "... "] + handle <- connectTo (ircConfigAddress config) (ircConfigPort config) + hSetBuffering handle NoBuffering + hSetEncoding handle utf8 + return handle fd <- handleToFd handle putStrLn "[IrcBot] Spawning reader threads..." myOwnThreadId <- myThreadId @@ -41,8 +51,7 @@ startIrcbot config masterChan myChan = do , ircServerNickname = ircConfigNickname config , ircServerCommandPrefix = ircConfigCommandPrefix config , ircServerChan = chan } - ircBotState = IrcBotState { ircBotStartTime = startTime - , ircBotPlugins = M.empty + ircBotState = IrcBotState { ircBotPlugins = M.empty , ircBotCommands = M.empty , ircBotChan = chan , ircBotMasterChan = masterChan @@ -60,8 +69,8 @@ startIrcbot config masterChan myChan = do killThread readerThreadId killThread masterReaderThreadId putStrLn "[IrcBot] Killing active plugins... " - let resumeData = ircBotResumeData ircBotState''' - ircPlugins = read (fromMaybe [] (M.lookup "PLUGINS" resumeData)) :: [String] + let resumeData' = ircBotResumeData ircBotState''' + ircPlugins = read (fromMaybe [] (M.lookup "PLUGINS" resumeData')) :: [String] evalStateT (mapM_ killIrcPlugin ircPlugins) ircBotState''' return () diff --git a/Hsbot/Irc/Types.hs b/Hsbot/Irc/Types.hs index 4b75085..63411df 100644 --- a/Hsbot/Irc/Types.hs +++ b/Hsbot/Irc/Types.hs @@ -9,7 +9,6 @@ module Hsbot.Irc.Types import Control.Concurrent import Control.Monad.State import qualified Data.Map as M -import Data.Time import System.IO import Hsbot.Irc.Config @@ -22,8 +21,7 @@ type IrcBot = StateT IrcBotState IO -- | An Ircbot state data IrcBotState = IrcBotState - { ircBotStartTime :: UTCTime -- the bot's uptime - , ircBotPlugins :: M.Map String (IrcPluginState, MVar (), ThreadId) -- Loaded plugins + { ircBotPlugins :: M.Map String (IrcPluginState, MVar (), ThreadId) -- Loaded plugins , ircBotCommands :: M.Map String [String] -- Loaded plugins , ircBotChan :: Chan IrcBotMsg -- The IrcBot's communication channel , ircBotMasterChan :: Chan BotMsg -- The Hsbot communication channel diff --git a/Hsbot/Plugin.hs b/Hsbot/Plugin.hs index 3feffa8..1493c73 100644 --- a/Hsbot/Plugin.hs +++ b/Hsbot/Plugin.hs @@ -11,6 +11,7 @@ import Control.Concurrent.MVar import Control.Exception import Control.Monad.State import qualified Data.Map as M +import Data.Maybe (fromMaybe) import Prelude hiding (catch) import Hsbot.Config @@ -28,17 +29,20 @@ spawnPlugins = do spawnPlugin :: BotConfig -> Bot () spawnPlugin (IrcBotConfig ircConfig) = do bot <- get - let chan = botChan bot + let mvar = botResumeData bot + name = ircConfigName ircConfig + resumeData <- liftIO $ takeMVar mvar + let pluginResumeData = fromMaybe M.empty $ M.lookup name resumeData + chan = botChan bot pchan <- liftIO (newChan :: IO (Chan BotMsg)) - mvar <- liftIO newEmptyMVar - threadId <- liftIO . forkIO $ finally (startIrcbot ircConfig chan pchan) (putMVar mvar ()) - let plugin = PluginState { pluginName = ircConfigName ircConfig + pluginMVar <- liftIO newEmptyMVar + threadId <- liftIO . forkIO $ finally (startIrcbot ircConfig chan pchan (Just $ show pluginResumeData)) (putMVar pluginMVar ()) + let plugin = PluginState { pluginName = name , pluginChan = pchan , pluginHandles = M.empty } plugins = botPlugins bot - put $ bot { botPlugins = M.insert (pluginName plugin) (plugin, mvar, threadId) plugins } - resumeData <- gets botResumeData - liftIO $ modifyMVar_ resumeData (\oldData -> return $ M.insert (ircConfigName ircConfig) M.empty oldData) + put $ bot { botPlugins = M.insert (pluginName plugin) (plugin, pluginMVar, threadId) plugins } + liftIO . putMVar mvar $ M.insert name pluginResumeData resumeData -- | Unloads a plugin unloadPlugin :: String -> Bot () -- cgit v1.2.3