From 6edb35727f9a8025ec3d3479892d58198431152d Mon Sep 17 00:00:00 2001 From: Jon Doe Date: Sat, 26 Sep 2020 21:26:42 +0200 Subject: [PATCH] add irc, add more handlers --- GypsFulvus.cabal | 28 +++- src/Carrion/Plugin/IO/IRC/Client.hs | 157 +++++++++++++++++++++++ src/Carrion/Plugin/TCL.hs | 10 +- src/GypsFulvus.hs | 12 +- src/{Test.hs => Test-BalanceBrackets.hs} | 0 src/Test-Carrion-IRC.hs | 18 +++ 6 files changed, 214 insertions(+), 11 deletions(-) create mode 100644 src/Carrion/Plugin/IO/IRC/Client.hs rename src/{Test.hs => Test-BalanceBrackets.hs} (100%) create mode 100644 src/Test-Carrion-IRC.hs diff --git a/GypsFulvus.cabal b/GypsFulvus.cabal index 97bb301..6d00b4f 100644 --- a/GypsFulvus.cabal +++ b/GypsFulvus.cabal @@ -14,7 +14,7 @@ cabal-version: >=1.10 extra-source-files: README.md library - exposed-modules: GypsFulvus, GypsFulvus.PluginStuff, Carrion.Plugin.IO.STDIO, Carrion.Plugin.TCL + exposed-modules: GypsFulvus, GypsFulvus.PluginStuff, Carrion.Plugin.IO.STDIO, Carrion.Plugin.TCL, Carrion.Plugin.IO.IRC.Client other-modules: default-language: Haskell2010 hs-source-dirs: src @@ -27,7 +27,17 @@ library hashable, monad-parallel, haskeline, - unix + unix, + connection >= 0.3.1, + irc-client, + irc-conduit >= 0.3.0.4, + irc-ctcp >= 0.1.3.0, + lens, + network-conduit-tls >= 1.3.2, + tls >= 1.5.4, + x509-validation >= 1.6.11, + bytestring + extra-libraries: tcl8.6 Includes: /usr/include/tcl.h, src/tclstubswrapper/tclstubs.h @@ -49,14 +59,24 @@ executable GypsFulvus hashable, monad-parallel, haskeline, - unix + unix, + connection >= 0.3.1, + irc-client, + irc-conduit >= 0.3.0.4, + irc-ctcp >= 0.1.3.0, + lens, + network-conduit-tls >= 1.3.2, + tls >= 1.5.4, + x509-validation >= 1.6.11, + bytestring + ghc-options: -O2 -threaded -with-rtsopts=-N -g hs-source-dirs: src - other-modules: GypsFulvus.PluginStuff,GypsFulvus, Carrion.Plugin.IO.STDIO, Carrion.Plugin.TCL + other-modules: GypsFulvus.PluginStuff,GypsFulvus, Carrion.Plugin.IO.STDIO, Carrion.Plugin.TCL, Carrion.Plugin.IO.IRC.Client exposed-modules: GypsFulvus extra-libraries: tcl8.6 Includes: /usr/include/tcl.h, diff --git a/src/Carrion/Plugin/IO/IRC/Client.hs b/src/Carrion/Plugin/IO/IRC/Client.hs new file mode 100644 index 0000000..cb7277c --- /dev/null +++ b/src/Carrion/Plugin/IO/IRC/Client.hs @@ -0,0 +1,157 @@ +{-# LANGUAGE OverloadedStrings #-} +module Carrion.Plugin.IO.IRC.Client + (initPlugin,tellCommands) +where +import GypsFulvus.PluginStuff(Manhole(..),Sewage(..), InitStatus(..),SewageAutorInfo(..),genericAutorToNSAutor,inspectManhole,regift, stripCommandPrefix') +import Network.IRC.Client +import Data.Conduit.Network.TLS +import Network.Connection +import Network.IRC.Conduit +import Network.TLS +import Network.TLS.Extra +import Data.X509.Validation +import Control.Monad.IO.Class (MonadIO, liftIO) +import Data.ByteString (ByteString) +import Data.Text.Encoding (decodeUtf8) +import Control.Lens +import Control.Concurrent(threadDelay,forkIO) +import qualified Data.Text as T +import Control.Concurrent.STM +import Control.Monad(liftM) +import Data.Monoid +import qualified Data.Map as M +import Data.ByteString(ByteString) +import Network.IRC.CTCP(CTCPByteString(..)) +import Control.Applicative ((<$>), (<|>)) +type MyNicknames = M.Map (T.Text) ([T.Text]) + + +a ♯ b = T.append a b +unpack = T.unpack +myPlugName :: T.Text +myPlugName = T.pack "IRC-Simple" +lOCAL :: T.Text +lOCAL = T.pack "local" + +mySignature = GenericStyleAutor myPlugName lOCAL lOCAL +tellCommands = ["tcl"] +privateBotCommands = ["!join","!part","!kick","!op","!cycle","!reconnect","!ostracise","tcl"] +myOwners = ["hastur"] + +myChannels :: [T.Text] +myChannels = ["#exquisitebot"] + +-- this dogshit irc library doesnt seem to have a concept of 'people in the channel(s)' +rPL_NAMREPLY :: Int +rPL_NAMREPLY = 353 + +joinHandler' :: EventHandler s +joinHandler' = EventHandler (\ev -> matchNumeric 331 ev <|> matchNumeric 332 ev) $ \_ args -> case args of + (c:_) -> do + send $ RawMsg $ "NAMES " ♯ c + _ -> pure () + +namesReplyHandler + :: a -> TMVar (M.Map T.Text [T.Text]) -> EventHandler s +namesReplyHandler mh nns = huntAlligators (matchNumeric' rPL_NAMREPLY (mh,nns)) $ \src ((mh,nns), (meirl:theEqualsSignAsASeparateElementWhyTheFuckNot:theChan:theNicknames:[])) -> do +-- let fff = (T.breakOn " :" (foldr1 (\a b -> a ♯ " *BOINK* " ♯ b) thetail)) +-- (theChan,theNicknames) = fff & _2 %~ (T.splitOn " " . T.drop 1) + grr <- liftIO . atomically $ do + lnns <- takeTMVar nns + let curList = M.lookup theChan lnns + fff = M.insert theChan (case curList of + Nothing -> T.splitOn " " theNicknames + Just cl -> cl ++ (T.splitOn " " theNicknames)) lnns + return fff + liftIO $ putStrLn $ "what the fuck did I just do: " ++ show grr + return () + +matchNumeric' + :: Int -> a1 -> Event a2 -> Maybe (a1, [a2]) +matchNumeric' n intruder ev = case _message ev of + Numeric num args | n == num -> Just (intruder,args) + _ -> Nothing + +huntCrocodiles + :: Getting (First b) (Message a1) b + -> a2 -> Event a1 -> Maybe (a2, b) +huntCrocodiles k mh ev = case preview k . _message $ ev of + Nothing -> Nothing + Just sth -> Just (mh,sth) + +unimplementedCommand :: T.Text +unimplementedCommand = "Command not implemented." + + +huntAlligators + :: (Event T.Text -> Maybe b) + -> (Source T.Text -> b -> IRC s ()) -> EventHandler s +huntAlligators mf cf = EventHandler mf cf + +fYourKickHandler :: Manhole -> EventHandler s +fYourKickHandler mh = huntAlligators (huntCrocodiles _Kick mh) $ \src (mh, (channame, nickname, reason)) -> do + tvarI <- get instanceConfig <$> getIRCState + iGotBooted <- liftIO . atomically $ do + theNick <- get nick <$> readTVar tvarI + return $ case src of + Channel c _ + | nickname == theNick -> True + | otherwise -> False + _ -> False + if(iGotBooted) then do + liftIO $ regift (Sewage mySignature (T.pack "got kicked from " ♯ channame)) mh + liftIO (threadDelay 10000000) + send $ Join channame + else return () + +spamCoordinator :: Manhole -> T.Text -> IO () +spamCoordinator mh msg = regift (Sewage mySignature msg) mh + +detectCommandHandler :: Manhole -> EventHandler s +detectCommandHandler mh = huntAlligators (huntCrocodiles _Privmsg mh) $ \src (mh,(tgt,blergh)) -> do + tvarI <- get instanceConfig <$> getIRCState + case blergh of + Right body -> do + let theC = ((T.breakOn " " body) ^. _1) + let fff = theC `elem` privateBotCommands + if(fff) then do + mCommand <- liftIO $ stripCommandLocal body mh + case mCommand of + Nothing -> return () + Just c -> do + + liftIO $ spamCoordinator mh body -- actually process the commands here + else return () + Left _ -> return () +stripCommandLocal :: T.Text -> Manhole -> IO (Maybe T.Text) +stripCommandLocal c m = stripCommandPrefix' c tellCommands m mySignature + +initPlugin :: Manhole -> IO InitStatus +initPlugin mh = do + let myHost = "darkarmy.chat" + myPort = 6697 + myNickname = "ExquisiteRobot" + cpara = defaultParamsClient (unpack $ decodeUtf8 myHost) "" + validate cs vc sid cc = do + -- First validate with the standard function + res <- (onServerCertificate $ clientHooks cpara) cs vc sid cc + -- Then strip out non-issues + return $ filter (`notElem` [UnknownCA, SelfSigned]) res + myClientConfig = (tlsClientConfig myPort myHost) { tlsClientTLSSettings = TLSSettings cpara + { clientHooks = (clientHooks cpara) + { onServerCertificate = validate } + , clientSupported = (clientSupported cpara) + { supportedVersions = [TLS12, TLS11, TLS10] + , supportedCiphers = ciphersuite_strong + } + } + } + rejoinOnKickHandler = fYourKickHandler mh + detectCommandHandler' = detectCommandHandler mh + conn = tlsConnection $ WithClientConfig myClientConfig + myNNS <- atomically $ newTMVar M.empty + let namesReplyHandler' = namesReplyHandler mh myNNS + mySpecialHandlers = [rejoinOnKickHandler,detectCommandHandler',joinHandler',namesReplyHandler'] + cfg = defaultInstanceConfig myNickname & channels %~ (myChannels ++) & handlers %~ (++ mySpecialHandlers) + forkIO $ runClient conn cfg () + return GoodInitStatus diff --git a/src/Carrion/Plugin/TCL.hs b/src/Carrion/Plugin/TCL.hs index ee61b8e..76b2b3a 100644 --- a/src/Carrion/Plugin/TCL.hs +++ b/src/Carrion/Plugin/TCL.hs @@ -127,8 +127,8 @@ initPlugin manhole = do -processCommand :: TCLInterpreterWrapper -> Sewage -> IO T.Text -processCommand wi s = do +processCommand :: TCLInterpreterWrapper -> Sewage -> Bool -> IO T.Text +processCommand wi s ip = do let tcl_EvalEx = getEvalEx wi tcl_GetStringResult = getGetStringResult wi tcl_CancelEval = getCancelEval wi @@ -150,6 +150,7 @@ processCommand wi s = do 0 -> tcl_GetStringResult interp >>= \rs -> if nullPtr == rs then dumpDebug ("Command: " ++ c ++" ; returned a null pointer result.") >> return "FAILED" else peekCString rs >>= \nrs -> dumpDebug ("Output of command: " ++ c ++ " ;" ++ nrs ++ ";") >> return nrs _ -> errorInfo >> tcl_GetStringResult interp >>= peekCString performFromIRC = doTheTCL $ "pub:tcl:perform \"" ++ sewNick ++ "\" \"" ++ sewMask ++ "\" {} \"" ++ sewChan ++ "\" {" ++ sewCmd ++ "}" + performAdminLevel = doTheTCL sewCmd -- harvester <- forkIO $ do -- threadDelay 15000000 -- putStrLn "cancelling thread!!!" @@ -157,7 +158,7 @@ processCommand wi s = do -- putStrLn $ "cancel status " ++ (show fff) -- hngggg <- tcl_AsyncInvoke interp 0 -- putStrLn $ "asyncinvoke returned " ++ (show hngggg) - res <- performFromIRC + res <- if (ip) then performAdminLevel else performFromIRC -- putStrLn "putting back the interp" atomically $ putTMVar i interp return $ T.pack res @@ -174,7 +175,8 @@ rEPL wrappedtclinterp manhole = let hmm = gnarlyBalanced $ T.unpack cmdBodyStripped case hmm of Nothing -> do - processedGift <- processCommand wrappedtclinterp giftStripped + let isPrivileged = if T.pack "tclAdmin " `T.isPrefixOf` (getSewage newGift) then True else False + processedGift <- processCommand wrappedtclinterp giftStripped isPrivileged regift (Sewage mySignature processedGift) manhole Just berror -> regift (Sewage mySignature (T.pack berror)) manhole Nothing -> return () diff --git a/src/GypsFulvus.hs b/src/GypsFulvus.hs index c135e73..37b0969 100644 --- a/src/GypsFulvus.hs +++ b/src/GypsFulvus.hs @@ -14,6 +14,7 @@ import Data.Hashable import qualified Control.Monad.Parallel as Par import qualified Carrion.Plugin.IO.STDIO as CPISTDIO import qualified Carrion.Plugin.TCL as TCLSIMP +import qualified Carrion.Plugin.IO.IRC.Client as IRCSIMP import Prelude hiding ((++),putStrLn,putStr) import Data.Text.IO(putStrLn, putStr) import Debug.Trace @@ -89,9 +90,9 @@ runForever s cmap iopids = amIIO <- isIOPlugin someGarbage iopids if (amIIO) then trySendToWorker s someGarbage cmap - else do - putStrLn $ T.pack theAutor ++ " sez:" - putStrLn $ theSewage + else return () + putStrLn $ T.pack theAutor ++ " sez:" + putStrLn $ theSewage trySendToWorker :: TMVar Sewer -> Sewage -> TMVar CommandMap -> IO () @@ -151,6 +152,8 @@ stdioPlugName = "STDIO haskeline" tclPlugName :: T.Text tclPlugName = "TCL-Simple" +ircPlugName :: T.Text +ircPlugName = "IRC-Simple" execMain :: IO () execMain = do @@ -162,6 +165,9 @@ execMain = do tryRegisterPlugin newSewer stdioPlugName CPISTDIO.initPlugin CPISTDIO.tellCommands atomically $ registerCommands commandMap stdioPlugName CPISTDIO.tellCommands atomically $ regiop stdioPlugName iopids + tryRegisterPlugin newSewer ircPlugName IRCSIMP.initPlugin IRCSIMP.tellCommands + atomically $ registerCommands commandMap ircPlugName IRCSIMP.tellCommands + atomically $ regiop ircPlugName iopids tryRegisterPlugin newSewer tclPlugName TCLSIMP.initPlugin TCLSIMP.tellCommands atomically $ registerCommands commandMap tclPlugName TCLSIMP.tellCommands let myTIDs = [] diff --git a/src/Test.hs b/src/Test-BalanceBrackets.hs similarity index 100% rename from src/Test.hs rename to src/Test-BalanceBrackets.hs diff --git a/src/Test-Carrion-IRC.hs b/src/Test-Carrion-IRC.hs new file mode 100644 index 0000000..9bda635 --- /dev/null +++ b/src/Test-Carrion-IRC.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE OverloadedStrings #-} +module Main +where +import Carrion.Plugin.IO.IRC.Client(initPlugin) +import GypsFulvus.PluginStuff +import Control.Concurrent.STM +import Control.Monad +import Control.Concurrent +import qualified Data.Text as T +main :: IO () +main = do + inchan <- atomically $ newTChan + outchan <- atomically $ newTChan + let mymanhole = Manhole inchan outchan + forkIO $ initPlugin mymanhole >> return () + forever $ do + newstuff <- atomically $ readTChan outchan + putStrLn $ "Backend " ++ (show $ getSewageAutor newstuff) ++ " returned " ++ (T.unpack $ getSewage newstuff)