Archived
1
0
Fork 0

Wrote most of the resume code for the core and the irc plugin.

This commit is contained in:
Julien Dessaux 2010-06-10 23:30:09 +02:00
parent 3410caa6f2
commit d97177ce3b
6 changed files with 57 additions and 50 deletions

View file

@ -18,12 +18,23 @@ import Hsbot.Plugin
import Hsbot.Types import Hsbot.Types
-- | Bot's main entry point -- | Bot's main entry point
hsbot :: [BotConfig] -> IO () hsbot :: [BotConfig] -> Maybe String -> IO ()
hsbot config = do hsbot config txtResumeData= do
startTime <- getCurrentTime 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... " putStrLn "[Hsbot] Opening communication channel... "
chan <- newChan :: IO (Chan BotMsg) chan <- newChan :: IO (Chan BotMsg)
mvar <- newMVar M.empty :: IO (MVar BotResumeData) mvar <- newMVar resumeData' :: IO (MVar BotResumeData)
putStrLn "[Hsbot] Installing signal handlers... " putStrLn "[Hsbot] Installing signal handlers... "
_ <- installHandler sigHUP (Catch $ sigHupHandler chan) Nothing _ <- installHandler sigHUP (Catch $ sigHupHandler chan) Nothing
_ <- installHandler sigTERM (Catch $ sigTermHandler chan) Nothing _ <- installHandler sigTERM (Catch $ sigTermHandler chan) Nothing
@ -36,10 +47,10 @@ hsbot config = do
putStrLn "[Hsbot] Entering main loop... " putStrLn "[Hsbot] Entering main loop... "
(status, botState') <- runLoop botState (status, botState') <- runLoop botState
putStrLn "[Hsbot] Killing active plugins... " putStrLn "[Hsbot] Killing active plugins... "
resumeData <- takeMVar mvar newResumeData <- takeMVar mvar
evalStateT (mapM_ killPlugin $ M.keys resumeData) botState' evalStateT (mapM_ killPlugin $ M.keys newResumeData) botState'
if status == BotReboot if status == BotReboot
then resumeHsbot resumeData then hsbot config (Just $ show newResumeData) -- TODO : exec on the hsbot launcher with the reload string
else return () else return ()
where where
runLoop :: BotState -> IO (BotStatus, BotState) runLoop :: BotState -> IO (BotStatus, BotState)
@ -50,10 +61,6 @@ hsbot config = do
BotContinue -> runLoop botState' BotContinue -> runLoop botState'
_ -> return (status, botState') _ -> return (status, botState')
resumeHsbot :: BotResumeData -> IO ()
resumeHsbot resumeData = do
print resumeData
-- | Run the bot main loop -- | Run the bot main loop
botCore :: Bot (BotStatus) botCore :: Bot (BotStatus)
botCore = do botCore = do

View file

@ -7,11 +7,11 @@ import Control.Exception (AsyncException, Handler (..), IOException, catch, catc
import Control.Monad.State import Control.Monad.State
import qualified Data.Map as M import qualified Data.Map as M
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Data.Time
import Network import Network
import Prelude hiding (catch) import Prelude hiding (catch)
import System.IO 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.Command
import Hsbot.Irc.Config import Hsbot.Irc.Config
@ -22,14 +22,24 @@ import Hsbot.Irc.Types
import Hsbot.Types import Hsbot.Types
-- | IrcBot's main entry point -- | IrcBot's main entry point
startIrcbot :: IrcConfig -> Chan BotMsg -> Chan BotMsg -> IO () startIrcbot :: IrcConfig -> Chan BotMsg -> Chan BotMsg -> Maybe String -> IO ()
startIrcbot config masterChan myChan = do startIrcbot config masterChan myChan txtResumeData = do
startTime <- getCurrentTime let resumeData = case txtResumeData of
Just txtData -> read txtData :: ResumeData -- TODO : catch exception
Nothing -> M.empty :: ResumeData
print resumeData
putStrLn "[IrcBot] Opening communication channel... " putStrLn "[IrcBot] Opening communication channel... "
chan <- newChan :: IO (Chan IrcBotMsg) chan <- newChan :: IO (Chan IrcBotMsg)
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, "... "] putStrLn $ concat ["[IrcBot] Connecting to ", ircConfigAddress config, "... "]
handle <- connectTo (ircConfigAddress config) (ircConfigPort config) handle <- connectTo (ircConfigAddress config) (ircConfigPort config)
hSetBuffering handle NoBuffering hSetBuffering handle NoBuffering
hSetEncoding handle utf8
return handle
fd <- handleToFd handle fd <- handleToFd handle
putStrLn "[IrcBot] Spawning reader threads..." putStrLn "[IrcBot] Spawning reader threads..."
myOwnThreadId <- myThreadId myOwnThreadId <- myThreadId
@ -41,8 +51,7 @@ startIrcbot config masterChan myChan = do
, ircServerNickname = ircConfigNickname config , ircServerNickname = ircConfigNickname config
, ircServerCommandPrefix = ircConfigCommandPrefix config , ircServerCommandPrefix = ircConfigCommandPrefix config
, ircServerChan = chan } , ircServerChan = chan }
ircBotState = IrcBotState { ircBotStartTime = startTime ircBotState = IrcBotState { ircBotPlugins = M.empty
, ircBotPlugins = M.empty
, ircBotCommands = M.empty , ircBotCommands = M.empty
, ircBotChan = chan , ircBotChan = chan
, ircBotMasterChan = masterChan , ircBotMasterChan = masterChan
@ -60,8 +69,8 @@ startIrcbot config masterChan myChan = do
killThread readerThreadId killThread readerThreadId
killThread masterReaderThreadId killThread masterReaderThreadId
putStrLn "[IrcBot] Killing active plugins... " putStrLn "[IrcBot] Killing active plugins... "
let resumeData = ircBotResumeData ircBotState''' let resumeData' = ircBotResumeData ircBotState'''
ircPlugins = read (fromMaybe [] (M.lookup "PLUGINS" resumeData)) :: [String] ircPlugins = read (fromMaybe [] (M.lookup "PLUGINS" resumeData')) :: [String]
evalStateT (mapM_ killIrcPlugin ircPlugins) ircBotState''' evalStateT (mapM_ killIrcPlugin ircPlugins) ircBotState'''
return () return ()

View file

@ -9,7 +9,6 @@ module Hsbot.Irc.Types
import Control.Concurrent import Control.Concurrent
import Control.Monad.State import Control.Monad.State
import qualified Data.Map as M import qualified Data.Map as M
import Data.Time
import System.IO import System.IO
import Hsbot.Irc.Config import Hsbot.Irc.Config
@ -22,8 +21,7 @@ type IrcBot = StateT IrcBotState IO
-- | An Ircbot state -- | An Ircbot state
data IrcBotState = IrcBotState 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 , ircBotCommands :: M.Map String [String] -- Loaded plugins
, ircBotChan :: Chan IrcBotMsg -- The IrcBot's communication channel , ircBotChan :: Chan IrcBotMsg -- The IrcBot's communication channel
, ircBotMasterChan :: Chan BotMsg -- The Hsbot communication channel , ircBotMasterChan :: Chan BotMsg -- The Hsbot communication channel

View file

@ -11,6 +11,7 @@ import Control.Concurrent.MVar
import Control.Exception import Control.Exception
import Control.Monad.State import Control.Monad.State
import qualified Data.Map as M import qualified Data.Map as M
import Data.Maybe (fromMaybe)
import Prelude hiding (catch) import Prelude hiding (catch)
import Hsbot.Config import Hsbot.Config
@ -28,17 +29,20 @@ spawnPlugins = do
spawnPlugin :: BotConfig -> Bot () spawnPlugin :: BotConfig -> Bot ()
spawnPlugin (IrcBotConfig ircConfig) = do spawnPlugin (IrcBotConfig ircConfig) = do
bot <- get 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)) pchan <- liftIO (newChan :: IO (Chan BotMsg))
mvar <- liftIO newEmptyMVar pluginMVar <- liftIO newEmptyMVar
threadId <- liftIO . forkIO $ finally (startIrcbot ircConfig chan pchan) (putMVar mvar ()) threadId <- liftIO . forkIO $ finally (startIrcbot ircConfig chan pchan (Just $ show pluginResumeData)) (putMVar pluginMVar ())
let plugin = PluginState { pluginName = ircConfigName ircConfig let plugin = PluginState { pluginName = name
, pluginChan = pchan , pluginChan = pchan
, pluginHandles = M.empty } , pluginHandles = M.empty }
plugins = botPlugins bot plugins = botPlugins bot
put $ bot { botPlugins = M.insert (pluginName plugin) (plugin, mvar, threadId) plugins } put $ bot { botPlugins = M.insert (pluginName plugin) (plugin, pluginMVar, threadId) plugins }
resumeData <- gets botResumeData liftIO . putMVar mvar $ M.insert name pluginResumeData resumeData
liftIO $ modifyMVar_ resumeData (\oldData -> return $ M.insert (ircConfigName ircConfig) M.empty oldData)
-- | Unloads a plugin -- | Unloads a plugin
unloadPlugin :: String -> Bot () unloadPlugin :: String -> Bot ()

5
TODO
View file

@ -1,6 +1,9 @@
:julien!~julien@ogu21.corp PRIVMSG #shbot :@quote graou snif :julien!~julien@ogu21.corp PRIVMSG #shbot :@quote graou snif
* Find a way to prevent the socket from being garbage collected, by writing a connection handler for example
* Design another way to launch and manage hsbot and it's configuration
* Find a way to handle bot reloading threw exec * Find a way to handle bot reloading threw exec
* Find a way so that not a single message/information would be lost in the case of a reboot
* write the vote system for the quote module * write the vote system for the quote module
* only the quote reporter should be able to edit it * only the quote reporter should be able to edit it
@ -20,10 +23,8 @@
* add register for casual conversations for plugins? * add register for casual conversations for plugins?
* add a "I have stuff to save so don't kill me too hard" status for plugins * add a "I have stuff to save so don't kill me too hard" status for plugins
* Handle unix signals properly
* Make the bot auto-reconnect (/!\ admin plugin!) * Make the bot auto-reconnect (/!\ admin plugin!)
* discard all trace with a color param and replace those with functions info/warn/error/debug * discard all trace with a color param and replace those with functions info/warn/error/debug
* write a safe reload : try reload before unloading * write a safe reload : try reload before unloading
* remove from Types.hs what can be removed from it * remove from Types.hs what can be removed from it

View file

@ -1,5 +1,5 @@
name: hsbot name: hsbot
version: 0.1.0 version: 0.2.1
cabal-version: >= 1.8 cabal-version: >= 1.8
build-type: Simple build-type: Simple
license: BSD3 license: BSD3
@ -20,20 +20,10 @@ Executable hsbot
Main-Is: Main.hs Main-Is: Main.hs
ghc-options: -Wall ghc-options: -Wall
extensions: DeriveDataTypeable ScopedTypeVariables extensions: DeriveDataTypeable ScopedTypeVariables
build-depends: base >= 4.1, build-depends: base >= 4.1 && < 5,
containers >= 0.3,
directory >= 1.0, directory >= 1.0,
filepath >= 1.1, filepath >= 1.1,
ghc >= 6.12,
haskell98 >= 1.0,
mtl >= 1.1,
network >= 2.2,
old-time >= 1.0,
parsec >= 3.1,
process >= 1.0, process >= 1.0,
random >= 1.0,
text >= 0.7,
time >= 1.1,
unix >= 2.4 unix >= 2.4
Library Library
@ -58,15 +48,13 @@ Library
Hsbot.Types Hsbot.Types
ghc-options: -Wall ghc-options: -Wall
extensions: DeriveDataTypeable ScopedTypeVariables extensions: DeriveDataTypeable ScopedTypeVariables
build-depends: base >= 4.1, build-depends: base >= 4.1 && < 5,
containers >= 0.3, containers >= 0.3,
directory >= 1.0, directory >= 1.0,
filepath >= 1.1, filepath >= 1.1,
ghc >= 6.12,
haskell98 >= 1.0, haskell98 >= 1.0,
mtl >= 1.1, mtl >= 1.1,
network >= 2.2, network >= 2.2,
old-time >= 1.0,
parsec >= 3.1, parsec >= 3.1,
random >= 1.0, random >= 1.0,
text >= 0.7, text >= 0.7,