From 9fa180ff6fff3355babf437b9144600c4f3f1360 Mon Sep 17 00:00:00 2001 From: Jon Doe Date: Sun, 27 Sep 2020 17:27:55 +0200 Subject: [PATCH] things seem to mostly work I guess ??? --- src/Carrion/Plugin/IO/IRC/Client.hs | 23 ++++++++++++++++------- src/Carrion/Plugin/TCL.hs | 11 +++++++---- src/GypsFulvus/PluginStuff.hs | 2 +- src/smeggdrop/smeggdrop/smeggdrop.tcl | 2 ++ state | 2 +- 5 files changed, 27 insertions(+), 13 deletions(-) diff --git a/src/Carrion/Plugin/IO/IRC/Client.hs b/src/Carrion/Plugin/IO/IRC/Client.hs index d6bee08..d843e98 100644 --- a/src/Carrion/Plugin/IO/IRC/Client.hs +++ b/src/Carrion/Plugin/IO/IRC/Client.hs @@ -133,9 +133,10 @@ fYourKickHandler nns = huntAlligators (matchType' _Kick nns) $ \src (nns, (chann spamCoordinator :: Manhole -> T.Text -> IO () spamCoordinator mh msg = regift (Sewage mySignature msg) mh +spamFromIRC mh msg thenick thechan = regift (Sewage (GenericStyleAutor myPlugName "local" thechan) msg) mh +stripDangerousNickname n = T.filter (\c -> (not . (c `elem`)) ['[',']','{','}']) -detectCommandHandler :: Manhole -> EventHandler s -detectCommandHandler mh = huntAlligators (matchType' _Privmsg mh) $ \src (mh,(tgt,blergh)) -> do +detectCommandHandler (nns,mh) = huntAlligators (matchType' _Privmsg (nns,mh)) $ \src ((nns,mh),(tgt,blergh)) -> do tvarI <- get instanceConfig <$> getIRCState case blergh of Right body -> do @@ -146,8 +147,14 @@ detectCommandHandler mh = huntAlligators (matchType' _Privmsg mh) $ \src (mh,(tg case mCommand of Nothing -> return () Just c -> do - - liftIO $ spamCoordinator mh body -- actually process the commands here + case src of + Channel thechannelname thenickname -> do + liftIO $ putStrLn $ "what the fuck: " ++ T.unpack thenickname ++ " " ++ T.unpack thechannelname + lnns <- liftIO . atomically $ readTMVar nns + let thenames = foldr1 (++) $ M.elems lnns -- fuck it all nicks + liftIO $ spamCoordinator mh $ T.pack "tcl cache put irc chanlist [list " ♯ (foldr1 (\a b -> a ♯ " " ♯ b) $ (map (stripDangerousNickname $ T.pack)) $ thenames) ♯ "]" + liftIO $ spamFromIRC mh body thenickname thechannelname -- actually process the commands here + _ -> return () -- no secret commands fuck it else return () Left _ -> return () stripCommandLocal :: T.Text -> Manhole -> IO (Maybe T.Text) @@ -173,14 +180,13 @@ initPlugin mh = do } } } - - detectCommandHandler' = detectCommandHandler mh conn = (tlsConnection $ WithClientConfig myClientConfig) & flood .~ 0 myNNS <- atomically $ newTMVar M.empty let namesReplyHandler' = namesReplyHandler mh myNNS rejoinOnKickHandler = fYourKickHandler myNNS mySpecialHandlers = [rejoinOnKickHandler,detectCommandHandler',joinHandler',namesReplyHandler',otherJoinHandler,otherPartHandler] cfg = defaultInstanceConfig myNickname & channels %~ (myChannels ++) & handlers %~ (++ mySpecialHandlers) + detectCommandHandler' = detectCommandHandler (myNNS,mh) myIRCState <- newIRCState conn cfg () forkIO $ runClientWith myIRCState forkIO $ acceptExternalComms myIRCState mh @@ -191,6 +197,9 @@ acceptExternalComms myIRCState manhole = regift g = atomically . (flip writeTChan g) . getOutputChan in forever $ do newGift <- liftIO $ inspectManhole manhole - runIRCAction (mapM (\fff -> send $ Privmsg "#exquisitebot" $ Right fff) (nlSplit $ getSewage newGift)) myIRCState + putStrLn $ "trying to maybe send to " ++ (T.unpack .getChannel . genericAutorToNSAutor . getSewageAutor $ newGift) + runIRCAction (mapM (\fff -> send $ Privmsg (getChannel . genericAutorToNSAutor . getSewageAutor $ newGift) $ Right fff) (nlSplit $ getSewage newGift)) myIRCState + + nlSplit = T.splitOn "\n" diff --git a/src/Carrion/Plugin/TCL.hs b/src/Carrion/Plugin/TCL.hs index 76b2b3a..90eb5e5 100644 --- a/src/Carrion/Plugin/TCL.hs +++ b/src/Carrion/Plugin/TCL.hs @@ -13,7 +13,7 @@ import System.Environment import Foreign.Ptr import Foreign.C.String import qualified Data.Text as T -import GypsFulvus.PluginStuff(Manhole(..),Sewage(..), InitStatus(..),SewageAutorInfo(..),genericAutorToNSAutor, stripCommandPrefix', regift) +import GypsFulvus.PluginStuff(Manhole(..),Sewage(..), InitStatus(..),SewageAutorInfo(..),genericAutorToNSAutor, stripCommandPrefix', regift, nsAutorToGenericAutor) data Tcl_Interp = Tcl_Interp deriving Show type Tcl_Interp_Ptr = Ptr Tcl_Interp type TCL_Actual_Version = CString @@ -54,12 +54,14 @@ foreign import ccall "dynamic" mkTcl_EvalEx :: FunPtr (Tcl_Interp_Ptr -> TclScri tu :: T.Text -> String tu = T.unpack tellCommands :: [T.Text] -tellCommands = map T.pack ["tcl"] +tellCommands = map T.pack ["tcl","tclAdmin"] +privilegedAutors = map T.pack ["core","STDIO haskeline","hastur","IRC-Simple"] myPluginName = T.pack "TCL-Simple" tl :: T.Text tl = T.pack "local" mySignature :: SewageAutorInfo mySignature = GenericStyleAutor myPluginName tl tl +sigWithChan ch = GenericStyleAutor myPluginName tl ch stripCommandLocal :: T.Text -> Manhole -> IO (Maybe T.Text) stripCommandLocal c m = stripCommandPrefix' c tellCommands m mySignature fuckingSewageAutorToFuckingTCLCommandFormatFuckYouSamStephenson @@ -175,9 +177,10 @@ rEPL wrappedtclinterp manhole = let hmm = gnarlyBalanced $ T.unpack cmdBodyStripped case hmm of Nothing -> do - let isPrivileged = if T.pack "tclAdmin " `T.isPrefixOf` (getSewage newGift) then True else False + let theOriginalChannel = getContext . nsAutorToGenericAutor . getSewageAutor $ newGift + let isPrivileged = if T.pack "tclAdmin " `T.isPrefixOf` (getSewage newGift) && ( getNick . genericAutorToNSAutor . getSewageAutor $ newGift) `elem` privilegedAutors then True else False processedGift <- processCommand wrappedtclinterp giftStripped isPrivileged - regift (Sewage mySignature processedGift) manhole + regift (Sewage (sigWithChan theOriginalChannel) processedGift) manhole Just berror -> regift (Sewage mySignature (T.pack berror)) manhole Nothing -> return () diff --git a/src/GypsFulvus/PluginStuff.hs b/src/GypsFulvus/PluginStuff.hs index aaedee4..82d0766 100644 --- a/src/GypsFulvus/PluginStuff.hs +++ b/src/GypsFulvus/PluginStuff.hs @@ -17,7 +17,7 @@ tooTeToSt a b = tup $ a ♯ "@" ♯ b stripCommandPrefix :: T.Text -> [T.Text] -> Either [Maybe T.Text] (Maybe T.Text) -stripCommandPrefix c = uniqueHit . filter (/= Nothing) . map (\cs -> T.stripPrefix cs (c ♯ " ")) +stripCommandPrefix c = uniqueHit . filter (/= Nothing) . map (\cs -> T.stripPrefix (cs ♯ " ") (c ♯ " ")) where uniqueHit cs = if (L.length cs == (1 :: Int)) then Right $ head cs else Left cs diff --git a/src/smeggdrop/smeggdrop/smeggdrop.tcl b/src/smeggdrop/smeggdrop/smeggdrop.tcl index 229cd83..d107665 100644 --- a/src/smeggdrop/smeggdrop/smeggdrop.tcl +++ b/src/smeggdrop/smeggdrop/smeggdrop.tcl @@ -158,6 +158,8 @@ proc interp_eval script { $::versioned_interpreter interpx . eval $script } +proc chanlist args { cache::get irc chanlist } + proc pub:tcl:perform {nick mask hand channel line} { global versioned_interpreter diff --git a/state b/state index 5ae158e..45e92f9 160000 --- a/state +++ b/state @@ -1 +1 @@ -Subproject commit 5ae158e5249eeadbe5758bbdbef7220e57c72a5d +Subproject commit 45e92f9730be1928fec14edcf5a653dec05a265c