From 7225d47e9c1f4c7032ad55fbe1d9f33ff205549c Mon Sep 17 00:00:00 2001
From: tv <tv@krebsco.de>
Date: Tue, 2 May 2017 21:59:10 +0200
Subject: ircout: init

---
 ircout.hs | 50 ++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 50 insertions(+)
 create mode 100644 ircout.hs

(limited to 'ircout.hs')

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
-- 
cgit v1.2.3