diff options
| -rw-r--r-- | src/Reaktor.hs | 62 | ||||
| -rw-r--r-- | src/Reaktor/Internal.hs | 3 | ||||
| -rw-r--r-- | src/Reaktor/Plugins/Register.hs | 23 |
3 files changed, 52 insertions, 36 deletions
diff --git a/src/Reaktor.hs b/src/Reaktor.hs index 2d3e7f5..77db22c 100644 --- a/src/Reaktor.hs +++ b/src/Reaktor.hs @@ -10,9 +10,10 @@ module Reaktor import Blessings import Control.Concurrent.Extended import Control.Exception -import Data.Attoparsec.ByteString.Char8 +import Data.Attoparsec.ByteString.Char8 (feed,parse) +import Data.Attoparsec.ByteString.Char8 (IResult(Done,Fail,Partial)) import Data.ByteString (ByteString) -import qualified Data.ByteString.Char8 as BS +import qualified Data.ByteString.Char8.Extended as BS import Data.Foldable (toList) import Data.Time.Clock.System import Data.Time.Format @@ -61,11 +62,14 @@ run Config{..} getPlugins = let actions = Actions{..} aIsSecure = cUseTLS aLog = putLog - aLogMsg msg = do - let bs = formatMessage msg - putLog $ SGR [38,5,235] "> " <> SGR [35,1] (Plain bs) - aSendQuiet = putOutMsg - aSend msg = aLogMsg msg >> aSendQuiet msg + aSend msg = logMsg msg >> putOutMsg msg + + logMsg msg = + case logMsgFilter msg of + Just msg' -> do + let bs = formatMessage msg' + aLog $ SGR [38,5,235] "> " <> SGR [35,1] (Plain bs) + Nothing -> return () mapM_ (\(s, f) -> installHandler s (Catch f) Nothing) [ (sigINT, shutdown) @@ -107,8 +111,7 @@ receiver Actions{..} putInMsg sockRecv = where receive "" = sockRecv >>= \case - Nothing -> do - aLog $ SGR [34,1] (Plain "# EOL") + Nothing -> logErr "EOL" Just buf -> receive buf receive buf = @@ -117,21 +120,27 @@ receiver Actions{..} putInMsg sockRecv = go :: IResult ByteString Message -> IO () go = \case Done rest msg -> do - -- TODO log message only if h hasn't disabled logging for it - let bs = formatMessage msg - aLog $ SGR [38,5,235] "< " <> SGR [38,5,244] (Plain bs) + logMsg msg putInMsg msg receive rest - p@(Partial _) -> do + p@(Partial _) -> sockRecv >>= \case - Nothing -> do - aLog $ SGR [31] (Plain "EOF") - Just msg -> - go (feed p msg) + Nothing -> logErr ("EOF with partial " <> Plain (BS.show p)) + Just msg -> go (feed p msg) + + f@(Fail _i _errorContexts _errMessage) -> + logErr ("failed to parse message: " <> Plain (BS.show f)) + + logErr s = aLog $ SGR [31,1] ("! receive: " <> s) + + logMsg msg = + case logMsgFilter msg of + Just msg' -> do + let bs = formatMessage msg' + aLog $ SGR [38,5,235] "< " <> SGR [38,5,244] (Plain bs) + Nothing -> return () - f@(Fail _i _errorContexts _errMessage) -> do - aLog $ SGR [31,1] (Plain (BS.pack $ show f)) sender :: IO Message -> (ByteString -> IO ()) -> IO () sender takeOutMsg sockSend = @@ -144,6 +153,21 @@ splitter plugins takeInMsg = mapM_ (\f -> forkIO (f msg)) plugins +logMsgFilter :: Message -> Maybe Message +logMsgFilter = \case + Message _ "PING" _ -> Nothing + Message _ "PONG" _ -> Nothing + Message p "PRIVMSG" ["NickServ",xs] | check -> do + Just (Message p "PRIVMSG" ["NickServ",xs']) + where + check = elem cmd ["IDENTIFY","RELEASE"] && length ws > 2 + ws = BS.words xs + (cmd:ws') = ws + (nick:_) = ws' + xs' = BS.unwords [cmd, nick, "<password>"] + msg -> Just msg + + privmsg :: ByteString -> [ByteString] -> Message privmsg msgtarget xs = Message Nothing "PRIVMSG" (msgtarget:BS.intercalate " " xs:[]) diff --git a/src/Reaktor/Internal.hs b/src/Reaktor/Internal.hs index 74db9c3..48a3f24 100644 --- a/src/Reaktor/Internal.hs +++ b/src/Reaktor/Internal.hs @@ -15,10 +15,7 @@ data Actions = Actions { aIsSecure :: Bool , aSend :: Message -> IO () - , aSendQuiet :: Message -> IO () - , aLog :: Blessings ByteString -> IO () - , aLogMsg :: Message -> IO () , aSetNick :: ByteString -> IO () , aGetNick :: IO ByteString diff --git a/src/Reaktor/Plugins/Register.hs b/src/Reaktor/Plugins/Register.hs index 314fc6f..ec3a11e 100644 --- a/src/Reaktor/Plugins/Register.hs +++ b/src/Reaktor/Plugins/Register.hs @@ -52,9 +52,7 @@ new Config{..} Actions{..} = do Just ConfigNickServ{..} = cNickServ release nick pass = do - -- TODO Password type that doesn't get logged? - aLogMsg (privmsg "NickServ" ["RELEASE", nick, "<password>"]) - aSendQuiet (privmsg "NickServ" ["RELEASE", nick, pass]) + aSend (privmsg "NickServ" ["RELEASE", nick, pass]) channelsArg = BS.intercalate "," cChannels -- TODO make this similar to privmsg (i.e. don't aSend) @@ -113,8 +111,7 @@ new Config{..} Actions{..} = do -- RFC2812 RPL_WELCOME Message _ "001" [msgtarget,_text] -> do nick <- aGetNick - aLogMsg (privmsg "NickServ" ["IDENTIFY", nick, "<password>"]) - aSendQuiet (privmsg "NickServ" ["IDENTIFY", nick, pass]) + aSend (privmsg "NickServ" ["IDENTIFY", nick, pass]) when (msgtarget /= nick) (release nick pass) -- TODO structured prefix, and check just for "NickServ"? @@ -124,22 +121,20 @@ new Config{..} Actions{..} = do let stx = ("\STX"<>) . (<>"\STX") if | text == "You are now identified for " <> stx nick <> "." -> do - -- XXX if msgtarget == nick then do - -- XXX join - -- XXX else do - -- XXX aSend (Message Nothing "NICK" [nick]) - -- otherwise join at NICK when (msgtarget == nick) join | text == stx nick <> " has been released." -> do aSend (Message Nothing "NICK" [nick]) + | text == "Invalid password for " <> stx nick <> "." -> do - -- TODO change nick + warning - error (BS.unpack text) + -- TODO warning + when (msgtarget == nick) join + | text == stx nick <> " is not a registered nickname." -> do - -- TODO change nick + warning - error (BS.unpack text) + -- TODO warning + when (msgtarget == nick) join + | otherwise -> pure () |