Archived
1
0
Fork 0

Added the cli parser and a config file handler for hsbot-irc.

This commit is contained in:
Julien Dessaux 2010-08-01 00:22:58 +02:00
parent 5cb9f9ccfc
commit 6888950b60
4 changed files with 216 additions and 4 deletions

View file

@ -1,14 +1,18 @@
module Hsbot.Irc.Config
( IrcConfig(..)
, ircDefaultConfig
, getIrcConfig
) where
import qualified Data.ConfigFile as C
import Data.Either.Utils
import Network
import System.Exit
import System.Posix.Files
-- | Configuration data type
data IrcConfig = IrcConfig
{ ircConfigName :: String -- The configuration name
, ircConfigAddress :: String -- the server's address
{ ircConfigAddress :: String -- the server's address
, ircConfigPort :: PortID -- the server's port
, ircConfigChannels :: [String] -- the Channels to join on start
, ircConfigNickname :: String -- the hsbot's nickname
@ -21,8 +25,7 @@ data IrcConfig = IrcConfig
-- | User configuration
ircDefaultConfig :: IrcConfig
ircDefaultConfig = IrcConfig
{ ircConfigName = "irc-alocalhost"
, ircConfigAddress = "localhost"
{ ircConfigAddress = "localhost"
, ircConfigPort = PortNumber 6667
, ircConfigChannels = ["#hsbot"]
, ircConfigNickname = "hsbot"
@ -32,3 +35,70 @@ ircDefaultConfig = IrcConfig
, ircConfigPlugins = ["Ping"]
}
-- | config file retrieving
getIrcConfig :: Maybe String -> IO (IrcConfig)
getIrcConfig maybePath =
case maybePath of
Just path -> do
doesFileExists <- fileExist path
case doesFileExists of
True -> do
fileStatus <- getFileStatus path
case isRegularFile $ fileStatus of
True -> compileIrcConfig ircDefaultConfig path
False -> do
putStrLn "Invalid configuration file path."
exitWith $ ExitFailure 1
False -> do
putStrLn "The specified configuration file does not exists."
exitWith $ ExitFailure 1
Nothing -> return ircDefaultConfig -- TODO : try defaults like $HOME/.hsbotrc, /etc/hsbotrc or /usr/local/etc/hsbotrc
-- | config file parsing
compileIrcConfig :: IrcConfig -> String -> IO (IrcConfig)
compileIrcConfig ircConfig path = do
val <- C.readfile C.emptyCP path
let cp = forceEither val
let address = case C.get cp "IRC" "address" of
Right this -> this
Left _ -> ircConfigAddress ircConfig
let port = case C.get cp "IRC" "port" of
Right this -> PortNumber $ fromIntegral (read this :: Int) -- TODO error handling
Left _ -> ircConfigPort ircConfig
let channels = case C.get cp "IRC" "channels" of
Right this -> map (lstrip ' ') (split this ',')
Left _ -> ircConfigChannels ircConfig
let nickname = case C.get cp "IRC" "nickname" of
Right this -> this
Left _ -> ircConfigNickname ircConfig
let password = case C.get cp "IRC" "password" of
Right this -> this
Left _ -> ircConfigPassword ircConfig
let realname = case C.get cp "IRC" "realname" of
Right this -> this
Left _ -> ircConfigRealname ircConfig
let commandPrefix = case C.get cp "IRC" "commandPrefix" of
Right this -> head this -- TODO error handling
Left _ -> ircConfigCommandPrefix ircConfig
let plugins = case C.get cp "IRC" "plugins" of
Right this -> map (lstrip ' ') (split this ',')
Left _ -> ircConfigPlugins ircConfig
return ircConfig { ircConfigAddress = address
, ircConfigPort = port
, ircConfigChannels = channels
, ircConfigNickname = nickname
, ircConfigPassword = password
, ircConfigRealname = realname
, ircConfigCommandPrefix = commandPrefix
, ircConfigPlugins = plugins }
where
split :: String -> Char -> [String]
split [] _ = [""]
split (c:cs) delim
| c == delim = "" : rest
| otherwise = (c : head rest) : tail rest
where rest = split cs delim
lstrip :: Char -> String -> String
lstrip x (c:cs) = if (x == c) then (lstrip x cs) else c:(lstrip x cs)
lstrip _ [] = []

30
HsbotIrcBot/LICENSE Normal file
View file

@ -0,0 +1,30 @@
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.

83
HsbotIrcBot/Main.hs Normal file
View file

@ -0,0 +1,83 @@
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
import Hsbot.Irc.Config
-- | 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
-- From there the initialization code truly begins
when (optDebug opts) . putStrLn $ "Got options : " ++ (show opts)
-- We find and parse the config file
ircConfig <- getIrcConfig $ optConfigFile opts
print $ ircConfigChannels ircConfig
print $ ircConfigPlugins ircConfig
-- CLI argument parting stuff {{{
-- | 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-irc version 0.3"
exitWith ExitSuccess))
"Show version"
]
-- | Usage header
header :: String
header = "Usage: hsbot-irc [-dhvV] [-f config_file] [-u user] [-g group]"
-- }}}

View file

@ -0,0 +1,29 @@
Name: hsbot-irc
Version: 0.3
Cabal-version: >=1.2
Synopsis: The irc part of 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-irc
Main-is: Main.hs
Ghc-options: -Wall
Extensions: DeriveDataTypeable ScopedTypeVariables
Build-depends: base >= 4.1 && < 5,
ConfigFile,
MissingH,
mtl,
network,
unix