summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--Config.hs61
-rw-r--r--irc.cabal19
-rw-r--r--ircout.hs50
-rw-r--r--main.hs68
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 [] ""