summaryrefslogtreecommitdiff
path: root/Hsbot
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--Hsbot/Core.hs29
-rw-r--r--Hsbot/Irc/Core.hs33
-rw-r--r--Hsbot/Irc/Types.hs4
-rw-r--r--Hsbot/Plugin.hs18
4 files changed, 51 insertions, 33 deletions
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 ()
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-23 18:22:34 +0000