hog (empty) → 0.1

raw patch · 4 files changed

+204/−0 lines, 4 filesdep +basedep +cmdargsdep +filepathsetup-changed

Dependencies added: base, cmdargs, filepath, irc, network, old-locale, time, unix

Files

LICENSE +30/−0
Setup.hs +2/−0
hog.cabal +25/−0
src/Main.hs +147/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright (c)2011, Chris Done++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 Chris Done 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.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ hog.cabal view

@@ -0,0 +1,25 @@+Name:                hog+Version:             0.1+Synopsis:            Simple IRC logger bot.+Description:         Simple IRC logger bot, connects to given channels and+                     logs lines to files of the corresponding channel names.+License:             BSD3+License-file:        LICENSE+Author:              Chris Done+Maintainer:          chrisdone@gmail.com+Copyright:           2010 Chris Done+Category:            Network+Build-type:          Simple+Cabal-version:       >=1.2++Executable hog+  Main-is:           Main.hs+  Hs-source-dirs:    src+  Build-depends:     base >4 && <5,+                     unix >= 2.4 && <2.5,+                     cmdargs >= 0.6 && <0.7,+                     network >= 2.2 && <2.3,+                     irc >= 0.4 && <0.5,+                     filepath >= 1.1 && <1.2,+                     time >= 1.1 && <1.2,+                     old-locale >= 1 && <2

+ src/Main.hs view

@@ -0,0 +1,147 @@+{-# LANGUAGE DeriveDataTypeable, RecordWildCards, ScopedTypeVariables,+  ViewPatterns #-} +{-# OPTIONS -Wall -fno-warn-missing-signatures -fno-warn-name-shadowing #-}++-- | Main entry point, just connect to the given IRC server and join+-- the given channels and log all messages received, to the given+-- file(s).++module Main where++import Control.Concurrent.Delay+import Control.Monad+import Control.Monad.Fix+import Data.Char+import Data.List+import Data.Time+import Network+import Network.IRC+import System.Console.CmdArgs+import System.FilePath+import System.IO+import System.Locale+import System.Posix++-- | Options for the executable.+data Options = Options+  { host      :: String       -- ^ The IRC server host/IP.+  , port      :: Int          -- ^ The remote port to connect to.+  , channels  :: String       -- ^ The channels to join (comma or+                              -- space sep'd).+  , logpath   :: FilePath     -- ^ Which directory to log to.+  , pass      :: Maybe String -- ^ Maybe a *server* password.+  , nick      :: String       -- ^ The nick.+  , user      :: String       -- ^ User (not real name) to use.+  , delay     :: Integer      -- ^ Reconnect delay (secs).+  } deriving (Show,Data,Typeable)++-- | Options for the executable.+options :: Options+options  = Options+  { host = def &= opt "irc.freenode.net" &= help "The IRC server."+  , port = def &= opt (6667::Int) &= help "The remote port."+  , channels = def &= opt "#hog" &= help "The channels to join."+  , logpath = def &= opt "." &= help "The directory to save log files."+  , pass = Nothing+  , nick = def &= opt "hog" &= help "The nickname to use."+  , user = def &= opt "hog" &= help "The user name to use."+  , delay = def &= opt (30::Integer) &= help "Reconnect delay (secs)."+  }+  &= summary "Hog IRC logger (C) Chris Done 2011"+  &= help "Simple IRC logger bot."++-- | Main entry point.+main :: IO ()+main = withSocketsDo $ do+  _ <- installHandler sigPIPE Ignore Nothing+  cmdArgs options >>= start++-- | Connect to the IRC server and start logging.+start :: Options -> IO ()+start options@Options{..} = do+  hSetBuffering stdout NoBuffering+  h <- connectTo host (PortNumber (fromIntegral port))+  hSetBuffering h NoBuffering+  register h options+  fix $ \repeat -> do+    line <- catch (Just `fmap` hGetLine h) $ \_e -> do+      delaySeconds delay+      start options+      return Nothing+    flip (maybe (return ())) line $ \line -> do+       putStrLn $ "<- " ++ line+       handleLine options h line+       repeat++-- | Register to the server by sending user/nick/pass/etc.+register :: Handle -> Options -> IO ()+register h Options{..} = do+  let send = sendLine h+  maybe (return ()) (send . ("PASS "++)) pass+  send $ "USER " ++ user ++ " * * *"+  send $ "NICK " ++ nick++-- | Handle incoming lines; ping/pong, privmsg, etc.+handleLine :: Options -> Handle -> String -> IO ()+handleLine options handle line = +  case decode line of+    Nothing -> putStrLn $ "Unable to decode line " ++ show line+    Just msg -> handleMsg options handle msg+    +-- | Handle an IRC message.+handleMsg :: Options -> Handle -> Message -> IO ()+handleMsg options h msg =+  case msg_command msg of+    "PING" -> reply $ msg {msg_command="PONG"}+    "376"  -> joinChannels options h+    "PRIVMSG" -> logMsg options msg+    _ -> return ()+    +  where reply = sendLine h . encode+  +-- | Log a privmsg of a given channel to the right file.+logMsg :: Options -> Message -> IO ()+logMsg options@Options{..} msg@Message{..} = do+  case msg_params of+    [('#':chan),msg] -> logLine options chan from msg+    _ -> putStrLn $ "Bogus message: " ++ show msg+    +    where from = case msg_prefix of+                   Just (NickName str _ _) -> "<" ++ str ++ "> "+                   _ -> "unknown"++-- | Log a line of a channel.+logLine :: Options -> String -> String -> String -> IO ()+logLine Options{..} (sanitize -> chan) from line =+  when (not (null chan)) $ do+    now <- fmap format getCurrentTime+    appendFile (logpath </> chan) $ +      now ++ " " ++ from ++ line ++ "\n"+      +  where format = formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S %Z"++-- | Sanitize a channel name.+sanitize :: String -> String+sanitize = filter ok where+  ok c = isDigit c || elem (toLower c) ['a'..'z']++-- | Join the requested channels.+joinChannels :: Options -> Handle -> IO ()+joinChannels Options{..} h = do+  let chans = words $ replace ',' ' ' channels+  putStrLn $ "Joining channels: " ++ show chans+  sendLine h $ "JOIN :" ++ intercalate "," chans++-- | Replace x with y in xs.+replace :: Eq a => a -> a -> [a] -> [a]+replace c y = go where+    go [] = []+    go (c':cs) | c'==c     = y : go cs+               | otherwise = c' : go cs++-- | Send a line on a handle, ignoring errors (like, if the socket's+-- closed.)+sendLine :: Handle -> String -> IO ()+sendLine h line = do+  catch (do hPutStrLn h line; putStrLn $ "-> " ++ line) $+    \_e -> return ()