diff options
| -rw-r--r-- | Config.hs | 61 | ||||
| -rw-r--r-- | irc.cabal | 19 | ||||
| -rw-r--r-- | ircout.hs | 50 | ||||
| -rw-r--r-- | main.hs | 68 |
4 files changed, 130 insertions, 68 deletions
diff --git a/Config.hs b/Config.hs new file mode 100644 index 0000000..fc959e1 --- /dev/null +++ b/Config.hs @@ -0,0 +1,61 @@ +{-# LANGUAGE ApplicativeDo #-} +{-# LANGUAGE RecordWildCards #-} + +module Config + ( Config(..) + , parseConfigFromArgs + ) + where + +import Data.Monoid +import Network.Socket (HostName,PortNumber) +import Options.Applicative + + +data Config = Config + { nick :: String + , msgtarget :: [String] + , server_hostname :: HostName + , server_port :: PortNumber + } + + +config :: Parser Config +config = do + nick <- strOption + ( long "nick" + <> value "ircout" + <> metavar "NICK" ) + + server_hostname <- strOption + ( long "host" + <> value "ni.r" + <> metavar "HOST" ) + + server_port <- option auto + ( long "port" + <> value 6667 + <> metavar "PORT") + + msgtarget <- some (argument str + ( metavar "TARGET..." + <> help + "List of channels and nicks. \ + \Ircout will join all channels. \ + \Users get messaged directly" + )) + + pure Config{..} + + +pinfo :: ParserInfo Config +pinfo = + info (config <**> helper) + ( fullDesc + <> progDesc "Read lines from stdin and forward them to IRC." + <> header "ircout - forward stdin to IRC" + ) + + +parseConfigFromArgs :: IO Config +parseConfigFromArgs = execParser pinfo diff --git a/irc.cabal b/irc.cabal new file mode 100644 index 0000000..afbdd60 --- /dev/null +++ b/irc.cabal @@ -0,0 +1,19 @@ +name: irc +version: 1.0.0 +license: MIT +author: tv <tv@krebsco.de> +maintainer: tv@krebsco.de +build-type: Simple +cabal-version: >=1.10 + +executable ircout + main-is: ircout.hs + build-depends: + async, + bytestring, + network, + optparse-applicative, + text, + base + default-language: Haskell2010 + ghc-options: -O2 -Wall -threaded diff --git a/ircout.hs b/ircout.hs new file mode 100644 index 0000000..e3d0296 --- /dev/null +++ b/ircout.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} + +import Control.Concurrent.Async (race) +import Control.Exception.Base (finally) +import Control.Monad (forever,unless) +import Data.List (intercalate,null) +import Data.Text (isPrefixOf,pack,replace,unpack) +import Network (withSocketsDo,PortID(..),connectTo) +import qualified Data.ByteString.Char8 as BS8 +import System.IO (hSetBuffering,hSetNewlineMode,hPutStrLn,hClose,hGetLine,BufferMode(LineBuffering),universalNewlineMode,Handle) + +import Config + + +main :: IO () +main = do + c@Config{..} <- parseConfigFromArgs + withSocketsDo $ do + h <- connectTo server_hostname (PortNumber server_port) + (`finally` hClose h) $ do + hSetNewlineMode h universalNewlineMode + hSetBuffering h LineBuffering + handshake c h >> race (ircAgent c h) (stdinForwarder c h) >>= print + + +handshake :: Config -> Handle -> IO () +handshake Config{..} h = do + hPutStrLn h ("NICK " ++ nick) + hPutStrLn h ("USER " ++ nick ++ " * 0 :" ++ nick) + unless (null channels) $ hPutStrLn h ("JOIN " ++ channels) + where + channels = intercalate "," $ filter ((=='#') . head) msgtarget + + +ircAgent :: Config -> Handle -> IO () +ircAgent Config{..} h = forever $ do + line <- hGetLine h + if (isPrefixOf "PING" (pack line)) then + hPutStrLn h (unpack (replace "PING" "PONG" (pack line))) + else + print line + + +stdinForwarder :: Config -> Handle -> IO () +stdinForwarder Config{..} h = forever $ do + line <- BS8.getLine + hPutStrLn h ("PRIVMSG " ++ msgtarget' ++ " :" ++ BS8.unpack line) + where + msgtarget' = intercalate "," msgtarget diff --git a/main.hs b/main.hs deleted file mode 100644 index 8ae5f54..0000000 --- a/main.hs +++ /dev/null @@ -1,68 +0,0 @@ -{-# LANGUAGE OverloadedStrings #-} - -import Control.Monad (forever) -import Network (withSocketsDo, PortID(..), connectTo) -import Network.Socket (HostName, PortNumber) -import System.IO (hSetBuffering, hSetNewlineMode, hPutStrLn, hClose, hGetLine, BufferMode(LineBuffering), universalNewlineMode, Handle) -import Control.Concurrent.Async (race) -import Control.Exception.Base (finally) -import Data.Text (isPrefixOf, pack, replace, unpack) - -import qualified Data.ByteString.Char8 as BS8 -import Network.Wai (requestBody, requestMethod, responseLBS) -import Network.Wai.Handler.Warp (run) -import Network.HTTP.Types (status200, status404) -import Network.HTTP.Types.Header (hContentType) -import Network.HTTP.Types.Method (methodPost) - -nick :: String -nick = "ni" - -chan :: String -chan = "#retiolum" - -server_hostname :: HostName -server_hostname = "ni.r" - -server_port :: PortNumber -server_port = 6667; - -warp_port :: Int -warp_port = 10080 - - -main :: IO () -main = withSocketsDo $ do - h <- connectTo server_hostname (PortNumber server_port) - (`finally` hClose h) $ do - hSetNewlineMode h universalNewlineMode - hSetBuffering h LineBuffering - - handshake h >> race (fromServer h) (warp h) >>= print - -handshake :: Handle -> IO () -handshake h = do - hPutStrLn h ("NICK " ++ nick) - hPutStrLn h ("USER " ++ nick ++ " * 0 :" ++ nick) - hPutStrLn h ("JOIN " ++ chan) - -fromServer :: Handle -> IO () -fromServer h = forever $ do - line <- hGetLine h - if (isPrefixOf "PING" (pack line)) then - hPutStrLn h (unpack (replace "PING" "PONG" (pack line))) - else - print line - -warp :: Handle -> IO () -warp h = - run warp_port app - where - app req f = - if requestMethod req == methodPost - then do - s <- requestBody req - hPutStrLn h ("PRIVMSG " ++ chan ++ " :" ++ BS8.unpack s) - f $ responseLBS status200 [(hContentType, "text/plain")] "OK" - else do - f $ responseLBS status404 [] "" |