diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -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. diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/hog.cabal b/hog.cabal new file mode 100644 --- /dev/null +++ b/hog.cabal @@ -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 diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 --- /dev/null +++ b/src/Main.hs @@ -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 ()