ircout: init

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 [] ""