adyxax/hsbot
Archived
1
0
Fork 0
Code Issues Activity

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

Browse source
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
Show stats Download patch file Download diff file Expand all files Collapse all files

29
Hsbot/Core.hs
View file

@ -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

33
Hsbot/Irc/Core.hs
View file

@ -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 ()

4
Hsbot/Irc/Types.hs
View file

@ -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

18
Hsbot/Plugin.hs
View file

@ -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 ()

5
TODO
View file

@ -1,6 +1,9 @@
: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 so that not a single message/information would be lost in the case of a reboot
* write the vote system for the quote module
* only the quote reporter should be able to edit it
@ -20,10 +23,8 @@
* add register for casual conversations 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!)
* discard all trace with a color param and replace those with functions info/warn/error/debug
* write a safe reload : try reload before unloading
* remove from Types.hs what can be removed from it

18
hsbot.cabal
View file

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