things seem to mostly work I guess ???

This commit is contained in:
Jon Doe 2020-09-27 17:27:55 +02:00 committed by Maciej Bonin
parent 80455d20ec
commit 9fa180ff6f
5 changed files with 27 additions and 13 deletions

View File

@ -133,9 +133,10 @@ fYourKickHandler nns = huntAlligators (matchType' _Kick nns) $ \src (nns, (chann
spamCoordinator :: Manhole -> T.Text -> IO () spamCoordinator :: Manhole -> T.Text -> IO ()
spamCoordinator mh msg = regift (Sewage mySignature msg) mh 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 (nns,mh) = huntAlligators (matchType' _Privmsg (nns,mh)) $ \src ((nns,mh),(tgt,blergh)) -> do
detectCommandHandler mh = huntAlligators (matchType' _Privmsg mh) $ \src (mh,(tgt,blergh)) -> do
tvarI <- get instanceConfig <$> getIRCState tvarI <- get instanceConfig <$> getIRCState
case blergh of case blergh of
Right body -> do Right body -> do
@ -146,8 +147,14 @@ detectCommandHandler mh = huntAlligators (matchType' _Privmsg mh) $ \src (mh,(tg
case mCommand of case mCommand of
Nothing -> return () Nothing -> return ()
Just c -> do Just c -> do
case src of
liftIO $ spamCoordinator mh body -- actually process the commands here 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 () else return ()
Left _ -> return () Left _ -> return ()
stripCommandLocal :: T.Text -> Manhole -> IO (Maybe T.Text) stripCommandLocal :: T.Text -> Manhole -> IO (Maybe T.Text)
@ -173,14 +180,13 @@ initPlugin mh = do
} }
} }
} }
detectCommandHandler' = detectCommandHandler mh
conn = (tlsConnection $ WithClientConfig myClientConfig) & flood .~ 0 conn = (tlsConnection $ WithClientConfig myClientConfig) & flood .~ 0
myNNS <- atomically $ newTMVar M.empty myNNS <- atomically $ newTMVar M.empty
let namesReplyHandler' = namesReplyHandler mh myNNS let namesReplyHandler' = namesReplyHandler mh myNNS
rejoinOnKickHandler = fYourKickHandler myNNS rejoinOnKickHandler = fYourKickHandler myNNS
mySpecialHandlers = [rejoinOnKickHandler,detectCommandHandler',joinHandler',namesReplyHandler',otherJoinHandler,otherPartHandler] mySpecialHandlers = [rejoinOnKickHandler,detectCommandHandler',joinHandler',namesReplyHandler',otherJoinHandler,otherPartHandler]
cfg = defaultInstanceConfig myNickname & channels %~ (myChannels ++) & handlers %~ (++ mySpecialHandlers) cfg = defaultInstanceConfig myNickname & channels %~ (myChannels ++) & handlers %~ (++ mySpecialHandlers)
detectCommandHandler' = detectCommandHandler (myNNS,mh)
myIRCState <- newIRCState conn cfg () myIRCState <- newIRCState conn cfg ()
forkIO $ runClientWith myIRCState forkIO $ runClientWith myIRCState
forkIO $ acceptExternalComms myIRCState mh forkIO $ acceptExternalComms myIRCState mh
@ -191,6 +197,9 @@ acceptExternalComms myIRCState manhole =
regift g = atomically . (flip writeTChan g) . getOutputChan in regift g = atomically . (flip writeTChan g) . getOutputChan in
forever $ do forever $ do
newGift <- liftIO $ inspectManhole manhole 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" nlSplit = T.splitOn "\n"

View File

@ -13,7 +13,7 @@ import System.Environment
import Foreign.Ptr import Foreign.Ptr
import Foreign.C.String import Foreign.C.String
import qualified Data.Text as T 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 data Tcl_Interp = Tcl_Interp deriving Show
type Tcl_Interp_Ptr = Ptr Tcl_Interp type Tcl_Interp_Ptr = Ptr Tcl_Interp
type TCL_Actual_Version = CString 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.Text -> String
tu = T.unpack tu = T.unpack
tellCommands :: [T.Text] 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" myPluginName = T.pack "TCL-Simple"
tl :: T.Text tl :: T.Text
tl = T.pack "local" tl = T.pack "local"
mySignature :: SewageAutorInfo mySignature :: SewageAutorInfo
mySignature = GenericStyleAutor myPluginName tl tl mySignature = GenericStyleAutor myPluginName tl tl
sigWithChan ch = GenericStyleAutor myPluginName tl ch
stripCommandLocal :: T.Text -> Manhole -> IO (Maybe T.Text) stripCommandLocal :: T.Text -> Manhole -> IO (Maybe T.Text)
stripCommandLocal c m = stripCommandPrefix' c tellCommands m mySignature stripCommandLocal c m = stripCommandPrefix' c tellCommands m mySignature
fuckingSewageAutorToFuckingTCLCommandFormatFuckYouSamStephenson fuckingSewageAutorToFuckingTCLCommandFormatFuckYouSamStephenson
@ -175,9 +177,10 @@ rEPL wrappedtclinterp manhole =
let hmm = gnarlyBalanced $ T.unpack cmdBodyStripped let hmm = gnarlyBalanced $ T.unpack cmdBodyStripped
case hmm of case hmm of
Nothing -> do 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 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 Just berror -> regift (Sewage mySignature (T.pack berror)) manhole
Nothing -> return () Nothing -> return ()

View File

@ -17,7 +17,7 @@ tooTeToSt a b = tup $ a ♯ "@" ♯ b
stripCommandPrefix stripCommandPrefix
:: T.Text -> [T.Text] -> Either [Maybe T.Text] (Maybe T.Text) :: 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 where
uniqueHit cs = if (L.length cs == (1 :: Int)) then Right $ head cs else Left cs uniqueHit cs = if (L.length cs == (1 :: Int)) then Right $ head cs else Left cs

View File

@ -158,6 +158,8 @@ proc interp_eval script {
$::versioned_interpreter interpx . eval $script $::versioned_interpreter interpx . eval $script
} }
proc chanlist args { cache::get irc chanlist }
proc pub:tcl:perform {nick mask hand channel line} { proc pub:tcl:perform {nick mask hand channel line} {
global versioned_interpreter global versioned_interpreter

2
state

@ -1 +1 @@
Subproject commit 5ae158e5249eeadbe5758bbdbef7220e57c72a5d Subproject commit 45e92f9730be1928fec14edcf5a653dec05a265c