summaryrefslogtreecommitdiff
path: root/HsbotMaster
diff options
context:
space:
mode:
Diffstat (limited to 'HsbotMaster')
-rw-r--r--HsbotMaster/.gitignore3
-rw-r--r--HsbotMaster/Hsbot/.gitignore2
-rw-r--r--HsbotMaster/Hsbot/Config.hs9
-rw-r--r--HsbotMaster/Hsbot/Core.hs91
-rw-r--r--HsbotMaster/Hsbot/Message.hs35
-rw-r--r--HsbotMaster/Hsbot/Plugin.hs67
-rw-r--r--HsbotMaster/Hsbot/PluginUtils.hs15
-rw-r--r--HsbotMaster/Hsbot/Types.hs72
-rw-r--r--HsbotMaster/LICENSE30
-rw-r--r--HsbotMaster/Main.hs74
-rw-r--r--HsbotMaster/Setup.hs5
-rw-r--r--HsbotMaster/hsbot.cabal38
12 files changed, 0 insertions, 441 deletions
diff --git a/HsbotMaster/.gitignore b/HsbotMaster/.gitignore
deleted file mode 100644
index feb4e56..0000000
--- a/HsbotMaster/.gitignore
+++ /dev/null
@@ -1,3 +0,0 @@
-.*.swp
-Session.vim
-dist
diff --git a/HsbotMaster/Hsbot/.gitignore b/HsbotMaster/Hsbot/.gitignore
deleted file mode 100644
index a5aa1b9..0000000
--- a/HsbotMaster/Hsbot/.gitignore
+++ /dev/null
@@ -1,2 +0,0 @@
-.*.swp
-Session.vim
diff --git a/HsbotMaster/Hsbot/Config.hs b/HsbotMaster/Hsbot/Config.hs
deleted file mode 100644
index 121cc98..0000000
--- a/HsbotMaster/Hsbot/Config.hs
+++ /dev/null
@@ -1,9 +0,0 @@
-module Hsbot.Config
- ( BotConfig (..)
- ) where
-
-import Hsbot.Irc.Config
-
--- | Configuration data type
-data BotConfig = IrcBotConfig IrcConfig
-
diff --git a/HsbotMaster/Hsbot/Core.hs b/HsbotMaster/Hsbot/Core.hs
deleted file mode 100644
index d634f10..0000000
--- a/HsbotMaster/Hsbot/Core.hs
+++ /dev/null
@@ -1,91 +0,0 @@
-module Hsbot.Core
- ( hsbot
- ) where
-
-import Control.Concurrent.Chan
-import Control.Concurrent.MVar
-import Control.Exception
-import Control.Monad.State
-import qualified Data.Map as M
-import Data.Time
-import Prelude hiding (catch)
-import System.IO()
-import System.Posix.Signals
-
-import Hsbot.Config
-import Hsbot.Message
-import Hsbot.Plugin
-import Hsbot.Types
-
--- | Bot's main entry point
-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 resumeData' :: IO (MVar BotResumeData)
- putStrLn "[Hsbot] Installing signal handlers... "
- _ <- installHandler sigHUP (Catch $ sigHupHandler chan) Nothing
- _ <- installHandler sigTERM (Catch $ sigTermHandler chan) Nothing
- putStrLn "[Hsbot] Spawning IrcBot plugins... "
- botState <- execStateT spawnPlugins BotState { botStartTime = startTime
- , botPlugins = M.empty
- , botChan = chan
- , botConfig = config
- , botResumeData = mvar }
- putStrLn "[Hsbot] Entering main loop... "
- (status, botState') <- runLoop botState
- putStrLn "[Hsbot] Killing active plugins... "
- newResumeData <- takeMVar mvar
- evalStateT (mapM_ killPlugin $ M.keys newResumeData) botState'
- if status == BotReboot
- then hsbot config (Just $ show newResumeData) -- TODO : exec on the hsbot launcher with the reload string
- else return ()
- where
- runLoop :: BotState -> IO (BotStatus, BotState)
- runLoop botState = do
- (status, botState') <- (runStateT botCore botState) `catches` [ Handler (\ (_ :: IOException) -> return (BotExit, botState))
- , Handler (\ (_ :: AsyncException) -> return (BotExit, botState)) ]
- case status of
- BotContinue -> runLoop botState'
- _ -> return (status, botState')
-
--- | Run the bot main loop
-botCore :: Bot (BotStatus)
-botCore = do
- chan <- gets botChan
- msg <- liftIO $ readChan chan
- case msg of
- IntMsg intMsg -> processInternalMessage intMsg
- UpdMsg updMsg -> processUpdateMessage updMsg
- RebMsg rebMsg -> processRebootMessage rebMsg
- ExiMsg exiMsg -> processExitMessage exiMsg
-
--- | Process an update command
-processUpdateMessage :: ResumeMsg -> Bot (BotStatus)
-processUpdateMessage msg = do
- resumeData <- gets botResumeData
- let from = resMsgFrom msg
- stuff = resMsgData msg
- liftIO $ modifyMVar_ resumeData (\oldData -> return $ M.insert from stuff oldData)
- return BotContinue
-
--- | signals handlers
-sigHupHandler :: Chan BotMsg -> IO ()
-sigHupHandler chan = writeChan chan $ RebMsg RebootMsg { rebMsgFrom = "HUP handler" }
-
--- | signals handlers
-sigTermHandler :: Chan BotMsg -> IO ()
-sigTermHandler chan = writeChan chan $ ExiMsg ExitMsg { exiMsgFrom = "TERM handler" }
-
diff --git a/HsbotMaster/Hsbot/Message.hs b/HsbotMaster/Hsbot/Message.hs
deleted file mode 100644
index 933394b..0000000
--- a/HsbotMaster/Hsbot/Message.hs
+++ /dev/null
@@ -1,35 +0,0 @@
-module Hsbot.Message
- ( processInternalMessage
- , processRebootMessage
- , processExitMessage
- ) where
-
-import Control.Monad.State
-import qualified Data.Map as M
-
-import Hsbot.PluginUtils
-import Hsbot.Types
-
--- | Processes an internal message
-processInternalMessage :: Msg -> Bot (BotStatus)
-processInternalMessage msg
- | msgTo msg == "CORE" = processCoreMessage msg
- | otherwise = do
- plugins <- gets botPlugins
- case M.lookup (msgTo msg) plugins of
- Just (plugin, _, _) -> sendToPlugin (IntMsg msg) plugin
- Nothing -> return ()
- return BotContinue
-
-processCoreMessage :: Msg -> Bot (BotStatus)
-processCoreMessage msg = do
- case msgType msg of
- "REBOOT" -> return BotReboot
- _ -> return BotContinue
-
-processRebootMessage :: RebootMsg -> Bot (BotStatus)
-processRebootMessage _ = return BotReboot -- TODO : check who is sending that to us
-
-processExitMessage :: ExitMsg -> Bot (BotStatus)
-processExitMessage _ = return BotExit -- TODO : check who is sending that to us
-
diff --git a/HsbotMaster/Hsbot/Plugin.hs b/HsbotMaster/Hsbot/Plugin.hs
deleted file mode 100644
index 1493c73..0000000
--- a/HsbotMaster/Hsbot/Plugin.hs
+++ /dev/null
@@ -1,67 +0,0 @@
-module Hsbot.Plugin
- ( killPlugin
- , spawnPlugins
- , spawnPlugin
- , unloadPlugin
- ) where
-
-import Control.Concurrent (forkIO)
-import Control.Concurrent.Chan
-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
-import Hsbot.Irc.Config
-import Hsbot.Irc.Core
-import Hsbot.Types
-
--- | spawns plugins
-spawnPlugins :: Bot ()
-spawnPlugins = do
- config <- gets botConfig
- mapM_ (spawnPlugin) config
-
--- | spawns a single plugin
-spawnPlugin :: BotConfig -> Bot ()
-spawnPlugin (IrcBotConfig ircConfig) = do
- bot <- get
- 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))
- 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, pluginMVar, threadId) plugins }
- liftIO . putMVar mvar $ M.insert name pluginResumeData resumeData
-
--- | Unloads a plugin
-unloadPlugin :: String -> Bot ()
-unloadPlugin name = do
- killPlugin name
- resumeData <- gets botResumeData
- liftIO $ modifyMVar_ resumeData (\oldData -> return $ M.delete name oldData)
-
--- | kills a plugin
-killPlugin :: String -> Bot ()
-killPlugin name = do
- bot <- get
- let oldPlugins = botPlugins bot
- -- We check if the plugin exists
- case M.lookup name oldPlugins of
- Just (_, mvar, threadId) -> do
- let newPlugins = M.delete name oldPlugins
- liftIO $ throwTo threadId UserInterrupt
- put $ bot { botPlugins = newPlugins }
- liftIO $ takeMVar mvar
- Nothing -> return ()
-
diff --git a/HsbotMaster/Hsbot/PluginUtils.hs b/HsbotMaster/Hsbot/PluginUtils.hs
deleted file mode 100644
index d09b3b4..0000000
--- a/HsbotMaster/Hsbot/PluginUtils.hs
+++ /dev/null
@@ -1,15 +0,0 @@
-module Hsbot.PluginUtils
- ( sendToPlugin
- ) where
-
-import Control.Concurrent
-import Control.Concurrent.Chan ()
-import Control.Monad.State
-
-import Hsbot.Types
-
--- | Sends a msg to a plugin
-sendToPlugin :: BotMsg -> PluginState -> Bot ()
-sendToPlugin botMsg plugin = do
- liftIO $ writeChan (pluginChan plugin) botMsg
-
diff --git a/HsbotMaster/Hsbot/Types.hs b/HsbotMaster/Hsbot/Types.hs
deleted file mode 100644
index ce1432b..0000000
--- a/HsbotMaster/Hsbot/Types.hs
+++ /dev/null
@@ -1,72 +0,0 @@
-module Hsbot.Types
- ( Bot
- , BotMsg (..)
- , BotResumeData
- , BotState (..)
- , BotStatus (..)
- , ExitMsg (..)
- , Msg (..)
- , Plugin
- , PluginState (..)
- , RebootMsg (..)
- , ResumeData
- , ResumeMsg (..)
- ) where
-
-import Control.Concurrent
-import Control.Monad.State
-import qualified Data.Map as M
-import Data.Time
-import System.IO
-
--- | The Bot monad
-type Bot = StateT BotState IO
-
--- | An Hsbot state
-data BotState = BotState
- { botStartTime :: UTCTime -- the bot's uptime
- , botPlugins :: M.Map String (PluginState, MVar (), ThreadId) -- Loaded plugins
- , botChan :: Chan BotMsg -- the bot's communication channel
- , botResumeData :: MVar BotResumeData -- the necessary data to resume the bot's operations on reboot
- }
-
--- | how we exit from the botLoop
-data BotStatus = BotExit | BotReboot | BotContinue deriving (Eq)
-
--- | Types to factorise resume data
-type ResumeData = M.Map String String
-type BotResumeData = M.Map String ResumeData
-
--- | The Plugin monad
-type Plugin = StateT PluginState IO
-
--- | A plugin state
-data PluginState = PluginState
- { pluginName :: String -- The plugin's name
- , pluginChan :: Chan BotMsg -- The plugin chan
- , pluginHandles :: M.Map String Handle -- the plugins's handles
- }
-
--- | A hsbot message
-data Msg = Msg
- { msgType :: String -- the message type
- , msgFrom :: String -- who issues it
- , msgTo :: String -- who it is destinated to
- , msgStuff :: String -- the message to be transfered
- } deriving (Show)
-
-data ResumeMsg = ResMsg
- { resMsgFrom :: String
- , resMsgData :: ResumeData
- } deriving (Show)
-
-data RebootMsg = RebootMsg
- { rebMsgFrom :: String
- } deriving (Show)
-
-data ExitMsg = ExitMsg
- { exiMsgFrom :: String
- } deriving (Show)
-
-data BotMsg = IntMsg Msg | UpdMsg ResumeMsg | RebMsg RebootMsg | ExiMsg ExitMsg deriving (Show)
-
diff --git a/HsbotMaster/LICENSE b/HsbotMaster/LICENSE
deleted file mode 100644
index a280988..0000000
--- a/HsbotMaster/LICENSE
+++ /dev/null
@@ -1,30 +0,0 @@
-Copyright (c)2010, Julien Dessaux
-
-All rights reserved.
-
-Redistribution and use in source and binary forms, with or without
-modification, are permitted provided that the following conditions are met:
-
- * Redistributions of source code must retain the above copyright
- notice, this list of conditions and the following disclaimer.
-
- * Redistributions in binary form must reproduce the above
- copyright notice, this list of conditions and the following
- disclaimer in the documentation and/or other materials provided
- with the distribution.
-
- * Neither the name of Julien Dessaux nor the names of other
- contributors may be used to endorse or promote products derived
- from this software without specific prior written permission.
-
-THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
-"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
-LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
-A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
-OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
-SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
-LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
-DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
-THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
-(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
-OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/HsbotMaster/Main.hs b/HsbotMaster/Main.hs
deleted file mode 100644
index ceac5d7..0000000
--- a/HsbotMaster/Main.hs
+++ /dev/null
@@ -1,74 +0,0 @@
-module Main (main) where
-
-import Control.Monad (when)
-import Prelude hiding (catch)
-import System.Console.GetOpt
-import System.Environment
-import System.Exit
-import System.IO
-
--- | Main function
-main :: IO ()
-main = do
- args <- getArgs
- -- Parse options, getting a list of option actions
- let (actions, nonOptions, errors) = getOpt RequireOrder options args
- -- Here we thread startOptions through all supplied option actions
- opts <- case (nonOptions, errors) of
- ([], []) -> foldl (>>=) (return defaultOptions) actions
- (_, _) -> do
- hPutStrLn stderr $ concat errors ++ usageInfo header options
- exitWith $ ExitFailure 1
- when (optDebug opts) . putStrLn $ "Got options : " ++ (show opts)
-
--- | CLI options
-data Options = Options
- { optDebug :: Bool
- , optConfigFile :: Maybe String
- , optGroup :: Maybe String
- , optUser :: Maybe String
- , optVerbose :: Bool
- } deriving (Show)
-
--- | CLI default options
-defaultOptions :: Options
-defaultOptions = Options { optDebug = False
- , optConfigFile = Nothing
- , optGroup = Nothing
- , optUser = Nothing
- , optVerbose = False }
-
--- | CLI options logic
-options :: [ OptDescr (Options -> IO Options) ]
-options =
- [ Option "d" ["debug"]
- (NoArg (\opt -> return opt { optDebug = True, optVerbose = True }))
- "Enter verbose debug mode and prevents Hsbot from forking in background"
- , Option "f" ["file"]
- (ReqArg (\arg opt -> return opt { optConfigFile = return arg }) "<config_file>")
- "The config file to use"
- , Option "g" ["group"]
- (ReqArg (\arg opt -> return opt { optGroup = return arg }) "<group>")
- "The group hsbot will run as"
- , Option "h" ["help"]
- (NoArg (\_ -> do
- putStrLn $ usageInfo header options
- exitWith ExitSuccess))
- "Print this help message"
- , Option "u" ["user"]
- (ReqArg (\arg opt -> return opt { optUser = return arg }) "<user>")
- "The user hsbot will run as"
- , Option "v" ["verbose"]
- (NoArg (\opt -> return opt { optVerbose = True }))
- "Enable verbose messages"
- , Option "V" ["version"]
- (NoArg (\_ -> do
- putStrLn "Hsbot version 0.3"
- exitWith ExitSuccess))
- "Show version"
- ]
-
--- | Usage header
-header :: String
-header = "Usage: hsbot [-dhvV] [-f config_file] [-u user] [-g group]"
-
diff --git a/HsbotMaster/Setup.hs b/HsbotMaster/Setup.hs
deleted file mode 100644
index 14a7f90..0000000
--- a/HsbotMaster/Setup.hs
+++ /dev/null
@@ -1,5 +0,0 @@
-#!/usr/bin/env runhaskell
-
-import Distribution.Simple
-
-main = defaultMain
diff --git a/HsbotMaster/hsbot.cabal b/HsbotMaster/hsbot.cabal
deleted file mode 100644
index 7cce1da..0000000
--- a/HsbotMaster/hsbot.cabal
+++ /dev/null
@@ -1,38 +0,0 @@
-Name: hsbot
-Version: 0.3
-Cabal-version: >=1.2
-Synopsis: A multi-purposes bot.
-Description:
- hsbot is a multi-purpose bot, written slowly, as long as I learned more
- haskell. It features IRC integration and some plugins. I tried to design
- a bot architecture as modular and as flexible as possible.
-Homepage: http://hsbot.adyxax.org/
-License: BSD3
-License-file: LICENSE
-Author: Julien Dessaux
-Maintainer: judessaux@gmail.com
-Copyright: Copyright (c) 2010 Julien Dessaux
-Category: Hsbot
-Build-type: Simple
-
-
-Executable hsbot
- Main-is: Main.hs
- Ghc-options: -Wall
- Extensions: DeriveDataTypeable ScopedTypeVariables
- Build-depends: base >= 4.1 && < 5
-
-Library
- Ghc-options: -Wall
- Extensions: DeriveDataTypeable ScopedTypeVariables
- Exposed-modules: Hsbot.Message,
- Hsbot.Types
- Build-depends: base >= 4.1 && < 5,
- containers >= 0.3,
- mtl >= 1.1,
- time >= 1.1
-
--- Extra files to be distributed with the package, such as examples or
--- a README.
--- Extra-source-files:
-
generated by cgit v1.2.3 (git 2.39.1) at 2024-10-05 20:11:55 +0000