Archived
1
0
Fork 0

Removed all the dynamic module loading stuff.

This commit is contained in:
Julien Dessaux 2010-04-21 21:01:07 +02:00
parent 4c76d3d40b
commit 455b18bc10
7 changed files with 31 additions and 58 deletions

View file

@ -9,7 +9,7 @@ import Hsbot.Types
-- | Imported plugins goes there
defaultPlugins :: [String]
defaultPlugins = [ "Ping", "Core" ]
defaultPlugins = []
-- | User server
localhost :: IrcServer

View file

@ -9,6 +9,9 @@ module Hsbot
, module Hsbot.Plugin
, module Hsbot.Types
, module Hsbot.Utils
, module Plugins.Core
, module Plugins.Ping
, module Plugins.Quote
) where
import Config
@ -21,4 +24,7 @@ import Hsbot.Main
import Hsbot.Plugin
import Hsbot.Types
import Hsbot.Utils
import Plugins.Core
import Plugins.Ping
import Plugins.Quote

View file

@ -77,12 +77,9 @@ processCoreCommand :: IntCmd -> IrcBot ()
processCoreCommand intCmd = do
let command' = intCmdCmd intCmd
case command' of
"LOAD" -> loadPlugin $ intCmdMsg intCmd
"RELOAD" -> reloadPlugin $ intCmdMsg intCmd
"LOAD" -> traceM $ inColor "hsbot has been compiled in static mode." [31]
"UNLOAD" -> unloadPlugin $ intCmdMsg intCmd
"REGISTER" -> registerCommand (intCmdMsg intCmd) (intCmdFrom intCmd)
"UNREGISTER" -> unregisterCommand (intCmdMsg intCmd) (intCmdFrom intCmd)
_ -> traceM $ inColor ("Invalid command : " ++ (show intCmd)) [31]
bot' <- get
traceM $ show bot'

View file

@ -13,6 +13,10 @@ import Hsbot.IRC
import Hsbot.Plugin
import Hsbot.Types
import Plugins.Core(mainCore)
import Plugins.Ping(mainPing)
import Plugins.Quote(mainQuote)
-- | Bot's main entry point
imain :: IO ()
imain = do
@ -24,6 +28,8 @@ imain = do
run :: IrcBot ()
run = do
initServer
mapM_ loadPlugin defaultPlugins
loadPlugin "Ping" mainPing
loadPlugin "Core" mainCore
loadPlugin "Quote" mainQuote
runServer

View file

@ -1,68 +1,35 @@
module Hsbot.Plugin
( loadPlugin
, sendToPlugin
, reloadPlugin
, unloadPlugin
) where
import Control.Concurrent
import Control.Concurrent.Chan
import Control.Concurrent.Chan()
import Control.Exception
import Control.Monad.State
import qualified Data.Map as M
import Data.Maybe
import System.IO
import System.Plugins
import Data.Maybe()
import System.IO()
import Hsbot.Types
import Hsbot.Utils
-- TODO : reload plugin, list plugins, etc
-- | Loads a plugin into an ircBot
loadPlugin :: String -> IrcBot ()
loadPlugin name = do
loadPlugin :: String -> (Chan BotMsg -> Chan BotMsg -> IO ()) -> IrcBot ()
loadPlugin name entryPoint = do
bot <- get
let oldPlugins = botPlugins bot
if name `M.member` oldPlugins
then traceM $ inColor ("Can't load plugin \"" ++ name ++ "\", this identifier has already been registered.") [31] -- or a wait, smthg like that?
else do
plugin <- liftIO $ effectivelyLoadPlugin name (botChannel bot)
case plugin of
Just plugin' -> do
put $ bot { botPlugins = M.insert name plugin' oldPlugins}
Nothing -> return ()
plugin <- liftIO $ effectivelyLoadPlugin name entryPoint (botChannel bot)
put $ bot { botPlugins = M.insert name plugin oldPlugins}
-- | Effectively try to load a plugin
effectivelyLoadPlugin :: String -> Chan BotMsg -> IO (Maybe Plugin)
effectivelyLoadPlugin name serverChan = do
-- TODO : test if Plugins/ ++ name ++ .hs exists
m <- liftIO $ makeAll ("Plugins/" ++ name ++ ".hs") ["-XScopedTypeVariables"]
plugin <- case m of
MakeSuccess _ _ -> do
ldstat <- load_ ("Plugins/" ++ name ++ ".o") [".","Hsbot","Hsbot/Plugins"] ("main" ++ name)
case ldstat of
LoadSuccess v entryPoint -> do
putStrLn $ inColor ("Loaded plugin: " ++ name) [32]
chan <- newChan :: IO (Chan BotMsg)
threadId <- forkIO $ entryPoint serverChan chan
return $ Just (Plugin name v threadId chan)
LoadFailure e -> do
putStrLn $ inColor ("Couldn't load plugin: " ++ name) [31]
mapM_ putStrLn e
return Nothing
MakeFailure e -> do
putStrLn $ inColor ("FATAL: Couldn't compile plugin: " ++ name) [31]
mapM_ putStrLn e
return Nothing
return plugin
-- | Reloads a plugin
-- TODO : make it a safe reload (compile before unloading)
reloadPlugin :: String -> IrcBot ()
reloadPlugin name = do
unloadPlugin name
loadPlugin name
effectivelyLoadPlugin :: String -> (Chan BotMsg -> Chan BotMsg -> IO ()) -> Chan BotMsg -> IO (Plugin)
effectivelyLoadPlugin name entryPoint serverChan = do
putStrLn $ inColor ("Loaded (static) plugin: " ++ name) [32]
chan <- newChan :: IO (Chan BotMsg)
threadId <- forkIO $ entryPoint serverChan chan
return $ Plugin name threadId chan
-- | Unloads a plugin
unloadPlugin :: String -> IrcBot ()
@ -73,9 +40,8 @@ unloadPlugin name = do
Just plugin -> do
let newPlugins = M.delete name oldPlugins
liftIO $ throwTo (pluginThreadId plugin) UserInterrupt
liftIO $ unloadAll $ pluginModule plugin
put $ bot { botPlugins = newPlugins }
Nothing -> return ()
Nothing -> return ()
-- | Sends a msg to a plugin
sendToPlugin :: BotMsg -> Plugin -> IrcBot ()

View file

@ -18,7 +18,6 @@ import Control.Monad.State
import qualified Data.Map as M
import Network
import System.IO
import System.Plugins
import System.Time (ClockTime)
-- | TODO : a monad for a channel, and a monad for a server, all together driven by a Bot?
@ -102,13 +101,12 @@ data BotMsg = InputMsg IrcMsg | OutputMsg IrcMsg | InternalCmd IntCmd deriving (
-- | A plugin (core side)
data Plugin = Plugin
{ pluginName :: String -- The plugin's name
, pluginModule :: Module -- The plugin himself
, pluginThreadId :: ThreadId -- The plugin thread
, pluginChannel :: Chan BotMsg -- The plugin channel
}
instance Show Plugin where
show (Plugin name _ _ _) = show name
show (Plugin name _ _) = show name
-- | A IrcPlugin ("user" side)
data PluginInstance = PluginInstance

2
TODO
View file

@ -1,8 +1,8 @@
:julien!~julien@ogu21.corp PRIVMSG #shbot :@quote graou snif
* Add the IrcMsg as an optional parameter for an internal command
* Solve the catching that never happen in main
* throwto exception to main thread
* list plugins
* write a safe reload : try reload before unloading
* discard all trace with a color param and replace those with functions info/warn/error/debug