infinity (empty) → 0.1.1

raw patch · 14 files changed

+672/−0 lines, 14 filesdep +basedep +haskell98dep +mtlbuild-type:Customsetup-changed

Dependencies added: base, haskell98, mtl, network, plugins

Files

• API.hs +58/−0
• Config.hs +40/−0
• INSTALL +31/−0
• IRC.hs +124/−0
• Infinity.hs +49/−0
• LICENSE +31/−0
• Plugins.hs +59/−0
• Plugins/GreetPlugin.hs +17/−0
• Plugins/PLUGINS +70/−0
• Plugins/SystemPlugin.hs +56/−0
• README +34/−0
• Setup.hs +39/−0
• Utils.hs +40/−0
• infinity.cabal +24/−0

@@ -0,0 +1,58 @@+module API where+import qualified Data.Map as M+import Control.Monad.Reader+import Control.Concurrent+import System.Plugins +import Data.Version+import System.Info+import Text.Printf+import System.IO+import Config++type PluginAction a = ReaderT PluginState IO a+type InfAction = (String -> String -> String -> String -> PluginAction String)+type PluginList = [(Module,InfinityPlugin)]++data InfinityPlugin = InfinityPlugin {+  name        :: String,              +  commands    :: [String],            +  help        :: [(String,String)], +  action      :: InfAction+}++data PluginState = PluginState {+  handle      :: Handle,+  remotechan  :: Chan String,+  addr        :: String,+  admins      :: [String],+  chans       :: [String],+  pluglist    :: [InfinityPlugin]+}++runAction :: PluginAction String -> PluginState -> IO String+runAction x r = runReaderT x r++-- functions usable by plugins+send :: String -> String -> PluginAction ()+send c s = do+  h <- asks handle+  io $ hPrintf h "%s %s\r\n" c s+  report $ ((printf "%s %s" c s) :: String)++privmsg :: String -> String -> PluginAction ()+privmsg c s = do+  h <- asks handle+  send "PRIVMSG" (c++" :"++s)++io :: IO a -> PluginAction a+io = liftIO++report :: String -> PluginAction ()+report s = do+  c    <- asks remotechan+  serv <- asks addr+  io $ writeChan c (serv ++ " *** " ++ s)++infinityVer = unwords ["Infinity",v,"-",arch,os,compilerName,(showVersion compilerVersion)]+ where+  v = "v0.1.1"

@@ -0,0 +1,40 @@+module Config (Server(..),Config(..),config) where++-- a datatype describing a particular IRC Server+data Server = Server {+  address        :: String,   -- what server to connect to+  portnum        :: Int,      -- what port+  channels       :: [String], -- what channels to enter+  nickname       :: String,   -- bot nick+  password       :: String,   -- bot password, can be empty+  realname       :: String,   -- bot's real name+  administrators :: [String]  -- bot admins+}++-- the actual config datatype, defines global config+-- options as well as a list of servers to connect to+data Config = Config {+   commandPrefixes :: String,   -- command prefixes+   servers         :: [Server]  -- list of servers to connect to+}++++-- define your servers to connect to here+freenode = Server {+  address        = "irc.freenode.org",+  portnum        = 6667,+  channels       = ["#bot-battle-royale"],+  nickname       = "infinitybot",+  password       = "l0lic0nh4x",+  realname       = "time copper",+  administrators = ["thoughtpolice"]+}++-- global configuration holding all options+config :: Config+config = Config {+  commandPrefixes = "?!@",+  servers         = [freenode]+}+

@@ -0,0 +1,31 @@+== prerequisites ==+ o ghc >= 6.6+ o hs-plugins++you may obtain hs-plugins by running:+$ darcs get http://www.cse.unsw.edu.au/~dons/code/hs-plugins/+and going from there.+++== building ==+building is as simple as doing your cabal-dance after some+config changes:+$ vi Config.hs+$ chmod +x Setup.hs+$ ./Setup.hs configure+$ ./Setup.hs build+++infinity is now compiled. :) it is not recommended to install,+as infinity dynamically loads its plugins; it is therefore copied+to the root infinity directory upon being built. you should run+it from there (the build process will move the needed files+automatically; notably the API.hi and API.o files, as well+as the infinity executable.)++08/12/07: infinity now loads and evaluates the Config.hs file+dynamically; meaning binary distributions can be made. :)++== cleaning up ==+to clean up the directory stucture, simply run:+$ ./Setup.hs clean

@@ -0,0 +1,124 @@+module IRC where+import Control.Concurrent+import Control.Monad.Reader+import System.Plugins+import Text.Printf+import System.IO+import List++import Plugins+import Config+import Utils+import qualified API as API++data Bot = Bot { socket      :: Handle,          -- server socket+                 rChan       :: Chan String,     -- response channel+                 cmdPrefixes :: String,          -- prefixes to be aware of+                 server      :: Server,          -- server info+                 pluginState :: API.PluginState, -- state given to all plugins+                 plugins     :: API.PluginList   -- list of module/plugin pairs+}+type InfBot = ReaderT Bot IO +++infInit :: InfBot ()+infInit = do+  -- pull all necessary data+  h      <- asks socket+  serv   <- asks server+  let n = nickname serv+      p = password serv+      r = realname serv+      c = channels serv++  -- set nick/user, give pass, join channels+  send "NICK" n+  send "USER" (n ++ " 0 * :"++r) +  unless (null p) $ do+    privmsg "nickserv" $ "identify "++p+  mapM_ (send "JOIN") c++  listen h++-- thanks go to don stewart's IRC bot tutorial,+-- i cribbed a bit of code from there for my+-- own nefarious purposes. :)+listen h = infinity $ do+  s  <- io $ hGetLine h+  s' <- sanitize s+  report s+  if ping s then pong s else eval h s'+ where+  infinity a = a >> infinity a             -- useless plug ;)+  ping       = isPrefixOf "PING :"+  pong x     = send "PONG" (':':drop 6 x) +  sanitize s = do  -- really ugly+    if ("PRIVMSG" `elem` (words s)) then do+          let  x    = (drop 1 . dropWhile (/="PRIVMSG") . words . drop 1) s+          let  chan = head x+               str  = (drop 1 . unwords . tail) x+               user = (takeWhile (/='!') . drop 1) s+          return (user,chan,str)+     else+         return ("","","")++eval :: Handle -> (String,String,String) -> InfBot ()+eval h (u,c,s) = do+  unless (null c && null s && null u) $ do+    p <- asks cmdPrefixes+    let com = (head . words) s+        arg = if (length $ words s) >= 2 then (drop 1 $ dropWhile (/=' ') s) else ""+    if (head com) `elem` p then+        let com' = tail com in+        case com' of+          -- here we've got a couple of commands that're built directly in+          "quit"    -> ifAdmin u (quit h) err+          x         -> do+                    plug <- findp x+                    case plug of+                      Left s -> do+                                privmsg c $ "Err: "++s+                      Right (_,p) -> do+                               let act = API.action p+                                   arg = (unwords . tail . words) s+                               pstate <- asks pluginState+                               ret <- io $ API.runAction (act u c com' arg) pstate+                               mapM_ (privmsg c) $ lines ret+     else return ()+ where+   ifAdmin :: String -> InfBot () -> InfBot () -> InfBot ()+   ifAdmin u y n = do+     serv <- asks server+     if (u `elem` (administrators serv)) then y else n+   quit :: Handle -> InfBot ()+   quit h = do+     send "QUIT" ":Exiting via command..."+     io $ hClose h+     report "disconnected..."+     io $ (myThreadId >>= killThread)+   err :: InfBot ()+   err = privmsg c "'fraid you can't do that, kid..."++-- convenience functions+io :: IO a -> InfBot a+io = liftIO++report :: String -> InfBot ()+report s = do+  c    <- asks rChan+  serv <- asks server+  io $ writeChan c ((address serv) ++ " *** " ++ s) ++findp :: String -> InfBot (Either String (Module,API.InfinityPlugin))+findp s = (return . lookupPlugin s) =<< (asks plugins)++send :: String -> String -> InfBot ()+send c s = do+  h <- asks socket+  io $ hPrintf h "%s %s\r\n" c s+  report $ ((printf "%s %s" c s) :: String)++privmsg :: String -> String -> InfBot ()+privmsg c s = do+  h <- asks socket+  send "PRIVMSG" (c++" :"++s)

@@ -0,0 +1,49 @@+module Main where+import Control.Monad.Reader+import Control.Concurrent+import System.Environment+import Network.Socket+import System.Exit+import System.IO+import Network++import qualified Config as C+import Plugins+import Utils+import API+import IRC++main = do+  a <- getArgs+  putStrLn "Loading configuration..."+  conf <- getConfig+  unless (null a) $ do+         case (head a) of+           "-conf" -> do+                      print conf+                      exitWith ExitSuccess+           "-h"    -> do+                      putStrLn "usage: ./infinity [-h|-conf]"+                      putStrLn "  -h       This info"+                      putStrLn "  -conf    Display configuration (Config.hs)" +                      exitWith ExitSuccess+           _       -> do +                      putStrLn "invalid command line option, try '-h'"+                      exitWith (ExitFailure 1)+  putStrLn "infinity initializing..."+  putStrLn "Global infinity configuration:" >> print conf+  putStrLn "Compiling & loading infinity plugins..."+  p <- (compilePlugins >>= loadPlugins)+  putStrLn "Finished plugin compilation & loading\n\n"+  -- spawn off our threads for every server+  chan <- newChan+  forM_ (C.servers conf) $ \s -> do+         h <- connectTo (C.address s) (PortNumber . fromIntegral $ C.portnum s)+         hSetBuffering h NoBuffering+         let ps = PluginState h chan (C.address s) (C.administrators s) (C.channels s) $ map (\(_,plug) -> plug) p+             st = Bot h chan (C.commandPrefixes conf) s ps p+         forkIO $ runReaderT infInit st++  -- now collect all data from threads+  reports <- getChanContents chan+  mapM_ (putStrLn) reports

@@ -0,0 +1,31 @@+Copyright Austin Seipp 2007++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 Austin Seipp 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.+

@@ -0,0 +1,59 @@+module Plugins where+import Control.Monad.Writer+import System.Directory+import System.Plugins+import Text.Printf+import Network+import API++compilePlugins :: IO [String]+compilePlugins = do+  c <- getDirectoryContents "Plugins/"+  let plugs = filter (\s -> (".hs"==) $ flip drop s $ (length s) - 3) c -- ugly+  objs <- execWriterT $ compile plugs+  return objs+ where+  compile :: [String] -> WriterT [String] IO ()+  compile []     = return ()+  compile (x:xs) = do+    o <- liftIO $ make ("Plugins/"++x) []+    case o of+      MakeSuccess code obj -> do+                     tell [obj]+                     case code of+                                ReComp -> liftIO $ putStrLn $ "Plugin compiled: " ++ x+                                _      -> return ()+      MakeFailure e -> do+                     liftIO $ putStrLn $ "Compile of plugin '"++x++"' failed:"+                     liftIO $ mapM_ putStrLn e+    compile xs++loadPlugins :: [String] -> IO PluginList+loadPlugins l = do+  lo <- execWriterT $ loadplugs l+  return lo+ where+  loadplugs :: [String] -> WriterT PluginList IO ()+  loadplugs [] = return ()+  loadplugs (x:xs) = do+    ls <- liftIO $ load_ x ["."] "plugin"+    case ls of+      LoadSuccess m v -> do+                       liftIO $ putStrLn $ "Plugin loaded: " ++ (name v)+                       tell [(m,v)]+      LoadFailure err -> do+                       liftIO $ putStrLn $ "Loading of plugin '"++x++"' failed:"+                       liftIO $ mapM_ putStrLn err+    loadplugs xs++++lookupPlugin :: String -> PluginList -> Either String (Module,InfinityPlugin)+lookupPlugin n l = +    let x = filter (\(_,ip) -> n `elem` (commands ip)) l in+    case x of+      [] -> Left $ "No plugin with command '"++n++"' found"+      _  -> if (length x) > 1 then+                Left $ "Multiple modules with same command '"++n++"' found!"+            else+                Right $ head x

@@ -0,0 +1,17 @@+module GreetPlugin where+import API++plugin :: InfinityPlugin+plugin = InfinityPlugin {+  name        = "Greet",+  commands    = ["hi","bye"],+  help        = [("hi","says 'hello world!")+                ,("bye","says 'goodbye cruel world!")],+  action      = greet+}++greet :: InfAction+greet user chan command str = do+  case command of+    "hi"  -> return "hello world!"+    "bye" -> return "goodbye cruel world!"

@@ -0,0 +1,70 @@+== introduction ==+writing plugins for infinity is remarkably simple.++here's a ~30 second tutorial to writing a plugin +that takes a string as an argument, and simply+reverses it.++1. create a file in Plugins/ under the name+   ReversePlugin.hs.+2. Put this in the file:++-- snip+module ReversePlugin where+import API -- imports Infinity's API++plugin :: InfinityPlugin+plugin = InfinityPlugin {+  name         = "ReverseString",+  commands     = ["rev"],+  description  = "reverses a string",+  action       = rev+}++rev :: InfAction+rev _ _ s = (return . reverse) s+-- end snip++3. start infinity+4. done. infinity automatically compiles +   and loads the plugin on startup! no+   static compilation! (this has the+   benefit that you don't need to+   recompile upon adding new plugins+   or modifying old ones, simply+   restart infinity)+++== notes ==+while writing plugins is quite simple, there+are a few things you should note:++1. the name of the file and the name+   of the module as declared in the first+   line of the file *must* be the same;+   you cannot have a plugin with a module+   name of "DestroyEarth" in the file+   Plugins/NuclearBomb.hs.+2. plugins can register multiple commands,+   these are passed to the action upon+   invocation as the first parameter+3. the action in the plugin needs to have+   a type of:+   String -> String -> String -> IO String++   the first argument is the nick of who+   invoked the command, the second is the+   name of the command that was invoked,+   while the third is the actual+   string that the user passed to+   the command+4. if you need to return multiple lines of+   output, simply turn your return your string+   enclosed in unlines, i.e.:++   return $ unlines ["Hello","World"]++   infinity will correctly break this+   into multiple lines and output it.++that is all. happy hacking...

@@ -0,0 +1,56 @@+module SystemPlugin where+import qualified Data.Map as M+import Control.Monad.Reader+import System.IO+import Data.List+import API+++plugin :: InfinityPlugin+plugin = InfinityPlugin {+  name        =  "System",+  commands    =  ["join"+                 ,"part"+                 ,"list"+                 ,"help"+                 ,"version"],+  help        = [("join","joins a channel")+                ,("part","parts a channel")+                ,("list","list commands")+                ,("help","shows help for a command")+                ,("version","show version info")],+  action = system+}++system :: InfAction+system user channel command args = do+  case command of+    "join" -> do+      admins <- asks admins+      if user `elem` admins then do+            mapM_ (\ch -> send "JOIN" ch) (words args)+            return $ "joined " ++ (concat $ intersperse " " $ words args)+       else return "Can't do that..."+    "part" -> do+      admins <- asks admins+      if user `elem` admins then do+            mapM_ (\ch -> send "PART" ch) (words args)+            return $ "parted " ++ (concat $ intersperse " " $ words args)+       else return "Can't do that..."+    "list" -> do+      plist <- asks pluglist+      let plist' = map (\p -> ((name p)++" provides: "++(concat $ intersperse " " $ commands p))) plist+      return $ unlines plist'+    "help" -> do+      plist   <- asks pluglist+      if (not.null) args then do+            let cmd    = (head . words) args+                plist' = filter (\p -> cmd `elem` (commands p)) plist+            if null plist' then do+                  return $ "No plugin with command '"++cmd++"' found..."+             else do+                   let x = head plist'+                   return $ M.findWithDefault "No help available..." cmd $ (M.fromList . help) x+       else return "Need a command, try '!help help'"+    "version" -> do+      return infinityVer

@@ -0,0 +1,34 @@+name:        infinity+synopsis:    a small, pluggable, configurable irc bot in haskell+description: infinity is an IRC bot written in haskell that is+designed to be extendable and modifiable. it is inspired largely+by don stewart's (or should I say #haskell's?) lambdabot.++== installation ==+see INSTALL for more information++== usage ==+standard usage is like so after being built:+$ ./infinity++infinity is now operational. :)+if you want to see infinity's compiled+in configuration, run+$ ./infinity -conf++== configuration ==+please see Config.hs++== writing plugins ==+please see Plugins/PLUGINS++== bugs, patches and feedback ==+if you have identified any bugs in infinity, have any patches+for commands/bugs you would like to submit, or you would like+to give feedback, simply send all these to:+austin at youareinferior dot net++darcs send is naturally the preferred way to transfer patches :)+++- austin s, 2007

@@ -0,0 +1,39 @@+#!/usr/bin/env runghc+import Distribution.Simple+import qualified Control.Exception as Ex+import System.Directory+import Control.Monad+import System.Info+import System.Exit+import List++b   = "infinity"+api = ["API.hi","API.o"] -- needed for plugins to load++main = defaultMainWithHooks $ defaultUserHooks {+      postBuild = copyInfinity,+      postClean = cleanInfinity+}+++copyInfinity _ _ _ _ = do+  copyFile ("dist/build/infinity/"++b) b+  mapM_ (\x -> copyFile ("dist/build/infinity/infinity-tmp/"++x) x) api+  return ExitSuccess++cleanInfinity _ _ _ _ = do+  Ex.catch (removeFile b >>         -- we don't care too much if there's no+            removeDirectory "dist") -- infinity binary in the topmost dir, or+           (\_ -> return ())        -- a dist/ dir+  clean "."+  clean "Plugins"+  return ExitSuccess+ where+   clean s = do+     c <- getDirectoryContents s+     forM_ c $ \f -> do+               if (".o"  `isSuffixOf` f ||+                   ".hi" `isSuffixOf` f ||+                   "~"   `isSuffixOf` f)+                then removeFile $ s++"/"++f+                else return ()

@@ -0,0 +1,40 @@+module Utils where+import Control.Monad.Reader+import System.Plugins+import Data.Version+import System.Info+import System.Exit+import Config++instance Show Server where+    show s = unlines $ ["\tServer:\t\t"  ++ (address s),+                        "\tPort:\t\t"    ++ (show . portnum $ s),+                        "\tChannels:\t"  ++ (show . channels $ s),+                        "\tNickname:\t"  ++ (nickname s),+                        "\tPassword:\t*****", -- we don't ever show the password+                        "\tReal name:\t" ++ (realname s)+                        ]++instance Show Config where+    show c = unlines $ ["Command prefixes:\t" ++ (show . commandPrefixes $ c),+                        "Server list:\n\n"      ++ (unlines . map show $ servers c)+                        ]++getConfig :: IO Config+getConfig = do+  o <- make "Config.hs" []+  case o of+    MakeSuccess _ obj -> do+              sym <- load_ obj ["."] "config"+              case sym of+                LoadSuccess _ v -> do+                           putStrLn "Loaded Config.hs..."+                           return v :: IO Config+                LoadFailure e -> do+                           putStrLn "Loading of Configuration FAILED:"+                           mapM_ putStrLn e+                           exitWith (ExitFailure 1)+    MakeFailure e -> do+              putStrLn "Compilation of Config.HS FAILED:"+              mapM_ putStrLn e+              exitWith (ExitFailure 1)

@@ -0,0 +1,24 @@+Name:                infinity+Version:             0.1.1+Description:         a tiny IRC bot, extendable through+                     plugins written in haskell+Synopsis:            a tiny IRC bot+Category:            network+License:             BSD3+License-file:        LICENSE+Author:              Austin Seipp+Maintainer:          austin@youareinferior.net+Build-Depends:       base, mtl, network, plugins, haskell98+Extra-Source-Files:  INSTALL, README,+		     API.hs,+		     Utils.hs,+		     IRC.hs,+		     Config.hs,+		     Plugins.hs,+		     Plugins/PLUGINS+		     Plugins/GreetPlugin.hs,+		     Plugins/SystemPlugin.hs++Executable:          infinity+Main-is:             Infinity.hs+ghc-options:         -O