add english words list

.gitignore

@@ -55,4 +55,10 @@ Thumbs.db
 dist-newstyle
 *.o
 *.hi
-*.conf
+*.conf
+
+#coredumps lol
+core.*
+
+#this isn't needed but I can't delete it, thanks nixos
+nixtclnonsense

.gitmodules

@@ -1,6 +1,6 @@
 [submodule "tclcurl-fa"]
 	path = tclcurl-fa
-	url = https://github.com/flightaware/tclcurl-fa.git
+	url = https://github.com/mmb1488/tclcurl-fa.git
 [submodule "tclx"]
 	path = tclx
 	url = https://github.com/flightaware/tclx.git

GypsFulvus.cabal

@@ -40,7 +40,7 @@ library
                        ini
 
          extra-libraries:     tcl8.6
-         Includes:            /usr/include/tcl.h,
+         Includes:            tcl.h,
                               src/tclstubswrapper/tclstubs.h
 
          ghc-options:
@@ -81,7 +81,8 @@ executable GypsFulvus
          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,
+--         extra-include-dirs:  /var/run/current-system/sw/include
+         Includes:            tcl.h,
                               src/tclstubswrapper/tclstubs.h
          C-Sources:           src/tclstubswrapper/tclstubs.c
          main-is:             Main.hs

Setup.hs

@@ -1,2 +1,4 @@
 import Distribution.Simple
 main = defaultMain
+
+

exquisiterobot.conf.example

@@ -2,3 +2,4 @@
 hostname= chat.freenode.org
 port= 6697
 channels = ##politics !docking #noshower
+nickname = ExquisiteTest

src/Carrion/Plugin/IO/IRC/Client.hs

@@ -1,6 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Carrion.Plugin.IO.IRC.Client
-  (initPlugin,tellCommands)
+  (initPlugin,tellCommands,myPlugName)
 where
 import GypsFulvus.PluginStuff(Manhole(..),Sewage(..), InitStatus(..),SewageAutorInfo(..),genericAutorToNSAutor,inspectManhole,regift, stripCommandPrefix')
 import Network.IRC.Client
@@ -26,20 +26,33 @@ import Network.IRC.CTCP(CTCPByteString(..))
 import Control.Applicative ((<$>), (<|>))
 import Data.List(nub,(\\))
 import Data.Ini
+import Data.Maybe(fromMaybe)
 import qualified Data.Text.IO as TIO
 type MyNicknames = M.Map (T.Text) ([T.Text])
 
 
+(♯) :: T.Text -> T.Text -> T.Text
 a ♯ b = T.append a b
+
+unpack :: T.Text -> String
 unpack = T.unpack
+
 myPlugName :: T.Text
 myPlugName = T.pack "IRC-Simple"
+
 lOCAL :: T.Text 
 lOCAL = T.pack "local"
 
-mySignature = GenericStyleAutor myPlugName lOCAL lOCAL
+mySignature :: SewageAutorInfo
+mySignature = GenericStyleAutor myPlugName myPlugName lOCAL
+
+tellCommands :: [T.Text]
 tellCommands = ["tcl"]
+
+privateBotCommands :: [T.Text]
 privateBotCommands = ["!join","!part","!kick","!op","!cycle","!reconnect","!ostracise","tcl"]
+
+myOwners :: [[Char]]
 myOwners = ["hastur"]
 
 --myChannels :: [T.Text]
@@ -72,8 +85,26 @@ replaceNNS nns theChan theNicknames= do
 
 otherJoinHandler :: EventHandler s
 otherJoinHandler = huntAlligators (matchType _Join) $ \_ c -> sendNAMES c
-otherPartHandler :: EventHandler s
+
-otherPartHandler = huntAlligators (matchType _Part) $ \_ (c,_) -> sendNAMES c
+otherPartHandler
+  :: TMVar (M.Map (NickName T.Text) [ChannelName T.Text])
+     -> EventHandler s
+otherPartHandler nns = huntAlligators (matchType' _Part nns) $ \src (nns, (c,r)) -> do
+  case src of
+    Channel n c -> do
+      liftIO . atomically $ removeFromNNS nns c n
+      return ()
+    _ -> return ()
+
+otherQuitHandler
+  :: TMVar (M.Map (NickName T.Text) [ChannelName T.Text])
+     -> EventHandler s
+otherQuitHandler nns = huntAlligators (matchType' _Quit nns) $ \src (nns, r) -> do
+  case src of
+    Channel n c -> do
+      liftIO . atomically $ removeFromNNS nns c n
+      return ()
+    _ -> return ()
 
 removeFromNNS
   :: (Ord k, Eq a) =>
@@ -91,7 +122,7 @@ 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:[])) ->
-    (liftIO . atomically $ replaceNNS nns theChan theNicknames) >>= (liftIO . putStrLn . show)
+    (liftIO . atomically $ replaceNNS nns theChan theNicknames) >> return () -- >>= (liftIO . putStrLn . show)
      
 
 matchNumeric'
@@ -117,6 +148,7 @@ huntAlligators
 huntAlligators mf cf = EventHandler mf cf
 
 
+fYourKickHandler :: TMVar (M.Map T.Text [T.Text]) -> EventHandler s
 fYourKickHandler nns = huntAlligators (matchType' _Kick nns) $ \src (nns, (channame, nickname, reason)) -> do
         tvarI <- get instanceConfig <$> getIRCState
         iGotBooted <- liftIO . atomically $ do
@@ -134,9 +166,16 @@ 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
+
+spamFromIRC :: Manhole -> T.Text -> T.Text -> T.Text -> IO ()
+spamFromIRC mh msg thenick thechan = regift (Sewage (GenericStyleAutor thenick myPlugName thechan) msg) mh
+
+stripDangerousNickname :: p -> T.Text -> T.Text
 stripDangerousNickname n = T.filter (\c -> (not . (c `elem`)) ['[',']','{','}'])
 
+detectCommandHandler
+  :: (TMVar (M.Map (ChannelName T.Text) [T.Text]), Manhole)
+     -> EventHandler s
 detectCommandHandler (nns,mh) = huntAlligators (matchType' _Privmsg (nns,mh)) $ \src ((nns,mh),(tgt,blergh)) -> do
               tvarI <- get instanceConfig <$> getIRCState
               case blergh of
@@ -150,68 +189,78 @@ detectCommandHandler (nns,mh) = huntAlligators (matchType' _Privmsg (nns,mh)) $
                       Just c -> do
                         case src of
                           Channel thechannelname thenickname -> do
-                            liftIO $ putStrLn $ "what the fuck: " ++ T.unpack thenickname ++ " " ++ T.unpack thechannelname
+--                            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
+                            let thenames = (fromMaybe [T.pack ""]) $ M.lookup thechannelname lnns
                             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)
 stripCommandLocal c m = stripCommandPrefix' c tellCommands m mySignature
 
+data IRCConfig = IRCConfig {getIRCHost:: T.Text, getIRCPort :: Int, getIRCChannels :: [T.Text], getIRCNickname :: T.Text} | FuckedIRCConfig T.Text
+
+getIRCConfig :: IO IRCConfig
 getIRCConfig = do
   c <- TIO.readFile "./exquisiterobot.conf" >>= return . parseIni
   case c of
-    Left _ -> return (T.pack "",0,T.pack "")
+    Left _ -> return $ FuckedIRCConfig "Couldn't read the configuration file."
     Right i -> do
       let host = lookupValue "Server" "hostname" i
           port = lookupValue "Server" "port" i
           channels = lookupValue "Server" "channels" i
-      case (host,port,channels) of
+          myNickname = lookupValue "Server" "nickname" i
-        (Right h, Right p, Right cs) -> return (h,(read . T.unpack $ p),cs)
+      case (host,port,channels,myNickname) of
-        _ -> return ("",0,"")
+        (Right h, Right p, Right cs, Right n) -> return $ IRCConfig h (read . T.unpack $ p) (T.splitOn " " cs) n
+        (h,p,cs,n) -> return $ FuckedIRCConfig $ foldr1 (♯) . map (T.pack . show) $ [h,p,cs,n]
+
 initPlugin :: Manhole -> IO InitStatus
 initPlugin mh = do
-  (myHost,myPort,myChannels') <- getIRCConfig
+  ircConfig <- getIRCConfig
-  let myChannels = T.splitOn " " myChannels'
+  case ircConfig of
-  let myNickname = "ExquisiteRobot"
+    IRCConfig myHost myPort myChannels myNickname -> do
-      cpara = defaultParamsClient (unpack myHost) ""
+      let cpara = defaultParamsClient (unpack myHost) ""
-      validate cs vc sid cc = do
+          validate cs vc sid cc = do
-         -- First validate with the standard function
+            -- First validate with the standard function
-         res <- (onServerCertificate $ clientHooks cpara) cs vc sid cc
+            res <- (onServerCertificate $ clientHooks cpara) cs vc sid cc
-         -- Then strip out non-issues
+          -- Then strip out non-issues
-         return $ filter (`notElem` [UnknownCA, SelfSigned]) res
+            return $ filter (`notElem` [UnknownCA, SelfSigned, Expired]) res
-      myClientConfig = (tlsClientConfig myPort (encodeUtf8 myHost)) { tlsClientTLSSettings = TLSSettings cpara
+          myClientConfig = (tlsClientConfig myPort (encodeUtf8 myHost)) { tlsClientTLSSettings = TLSSettings cpara
-    { clientHooks = (clientHooks cpara)
+                                                                          { clientHooks = (clientHooks cpara)
-      { onServerCertificate = validate }
+                                                                            { onServerCertificate = validate }
-    , clientSupported = (clientSupported cpara)
+                                                                          , clientSupported = (clientSupported cpara)
-      { supportedVersions = [TLS12, TLS11, TLS10]
+                                                                            { supportedVersions = [TLS12, TLS11, TLS10]
-      , supportedCiphers = ciphersuite_strong
+                                                                            , supportedCiphers = ciphersuite_strong
-      }
+                                                                            }
-    }
+                                                                          }
-  }
+                                                                        }
-      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 myNNS, otherQuitHandler myNNS]
-      cfg  = defaultInstanceConfig myNickname & channels %~ (myChannels ++) & handlers %~ (++ mySpecialHandlers)
+          cfg  = defaultInstanceConfig myNickname & channels %~ (myChannels ++) & handlers %~ (++ mySpecialHandlers)
-      detectCommandHandler' = detectCommandHandler (myNNS,mh)
+          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
-  return GoodInitStatus
+      return GoodInitStatus
-
+    FuckedIRCConfig err -> return $ BadInitStatus err
+    
+acceptExternalComms :: MonadIO f => IRCState s -> Manhole -> f b
 acceptExternalComms myIRCState manhole =
   let inspectManhole = atomically . readTChan . getInputChan
       regift g = atomically . (flip writeTChan g) . getOutputChan in
   forever $ do
     newGift <- liftIO $ inspectManhole manhole
-    putStrLn $ "trying to maybe send to " ++ (T.unpack .getChannel . genericAutorToNSAutor . getSewageAutor $ newGift)
+--    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
+    
+    runIRCAction (mapM (\fff -> send $ Privmsg (getChannel . genericAutorToNSAutor . getSewageAutor $ newGift) $ Right fff) (foldr1 (++) . map (T.chunksOf 255) . nlSplit $ getSewage newGift)) myIRCState
 
 
 
+nlSplit :: T.Text -> [T.Text]
 nlSplit = T.splitOn "\n"

src/Carrion/Plugin/IO/STDIO.hs

@@ -1,9 +1,8 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Carrion.Plugin.IO.STDIO
     ( initPlugin,
-      processCommand,
-      testThing,
       tellCommands,
+      myPlugName
     ) where
 import Control.Monad.IO.Class
 import Control.Monad
@@ -27,7 +26,8 @@ testThing = runInputT defaultSettings loop
                Just "quit" -> return ()
                Just input -> do outputStrLn $ T.unpack ("Input was: " ++ T.pack input)
                                 loop
-mySignature = GenericStyleAutor "STDIO haskeline" "local" "local"
+myPlugName = "STDIO haskeline"
+mySignature = GenericStyleAutor myPlugName myPlugName "local"
 tellCommands = [""]
 
 stripCommandLocal c m = stripCommandPrefix' c tellCommands m mySignature

src/Carrion/Plugin/TCL.hs

@@ -2,8 +2,8 @@
 
 module Carrion.Plugin.TCL
     ( initPlugin,
-      processCommand,
+      tellCommands,
-      tellCommands
+      myPlugName
     ) where
 import Control.Monad
 import Control.Concurrent(forkIO, threadDelay, killThread)
@@ -53,27 +53,34 @@ 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","tclAdmin"]
+
+privilegedAutors :: [T.Text]
 privilegedAutors = map T.pack ["core","STDIO haskeline","hastur","IRC-Simple"]
+
+myPluginName :: T.Text
 myPluginName = T.pack "TCL-Simple"
-tl :: T.Text
+myPlugName = myPluginName
-tl = T.pack "local"
+lOCAL :: T.Text
+lOCAL = T.pack "local"
+
 mySignature :: SewageAutorInfo
-mySignature = GenericStyleAutor myPluginName tl tl
+mySignature = GenericStyleAutor myPluginName myPluginName lOCAL
-sigWithChan ch = GenericStyleAutor myPluginName tl ch
+
+sigWithChan :: T.Text -> SewageAutorInfo
+sigWithChan ch = GenericStyleAutor myPluginName myPluginName ch
+
 stripCommandLocal :: T.Text -> Manhole -> IO (Maybe T.Text)
 stripCommandLocal c m = stripCommandPrefix' c tellCommands m mySignature
-fuckingSewageAutorToFuckingTCLCommandFormatFuckYouSamStephenson
-  :: SewageAutorInfo -> String -> TCLCommand
-fuckingSewageAutorToFuckingTCLCommandFormatFuckYouSamStephenson b = case b of
-  GenericStyleAutor a b c -> fuckingSewageAutorToFuckingTCLCommandFormatFuckYouSamStephenson . genericAutorToNSAutor $ GenericStyleAutor a b c
-  NetworkIdentStyleAutor a b c -> TCLCommand (tu a) (show b) "" (tu c)
 
 
 mkTCLCommandFromAIAndMsg :: SewageAutorInfo -> String -> TCLCommand
-mkTCLCommandFromAIAndMsg = fuckingSewageAutorToFuckingTCLCommandFormatFuckYouSamStephenson
+mkTCLCommandFromAIAndMsg b = case b of
-
+  GenericStyleAutor a b c -> mkTCLCommandFromAIAndMsg . genericAutorToNSAutor $ GenericStyleAutor a b c
+  NetworkIdentStyleAutor a b c -> TCLCommand (tu a) (show b) "" (tu c)
+  
 data TCLInterpreterWrapper = TCLInterpreterWrapper {getInterp :: TMVar(Tcl_Interp_Ptr),
                                                     getEvalFile :: Tcl_EvalFile_Sig,
                                                     getEvalEx :: Tcl_EvalEx_Sig,
@@ -84,15 +91,17 @@ data TCLInterpreterWrapper = TCLInterpreterWrapper {getInterp :: TMVar(Tcl_Inter
 
 lEN_AUTO :: Int
 lEN_AUTO = -1
+
 eVAL_FLAGS_CLEAR :: Int
 eVAL_FLAGS_CLEAR = 0
 
-dumpDebug _ = return ()
+--dumpDebug :: Monad m => p -> m ()
-
+--dumpDebug _ = return ()
+dumpDebug = putStrLn
 initPlugin :: Manhole -> IO InitStatus
 initPlugin manhole = do
   myFakeArg0 <- getExecutablePath >>= newCString
-  myTCLDl <- dlopen "/usr/lib/libtcl8.6.so" [RTLD_NOW]
+  myTCLDl <- dlopen "libtcl8.6.so" [RTLD_NOW]
   let bless name convf = dlsym myTCLDl name >>= \fp -> return $ convf $ fp
   tcl_CreateInterp <- bless "Tcl_CreateInterp" mkTcl_CreateInterp
   interp <- tcl_CreateInterp
@@ -146,25 +155,20 @@ processCommand wi s ip = do
   let runscript s = tcl_EvalEx interp s lEN_AUTO eVAL_FLAGS_CLEAR
       runTclCommand s = newCString s >>= runscript
       errorInfo = runTclCommand "return $errorInfo"
-      
       doTheTCL c = runTclCommand c >>= \st ->
         case st of
           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!!!"
---    fff <- tcl_CancelEval interp nullPtr nullPtr 0x100000
---    putStrLn $ "cancel status " ++ (show fff)
---    hngggg <- tcl_AsyncInvoke interp 0
---    putStrLn $ "asyncinvoke returned " ++ (show hngggg)
   res <- if (ip) then performAdminLevel else performFromIRC
---  putStrLn "putting back the interp"
   atomically $ putTMVar i interp
   return $ T.pack res
 
+sigWithChan' :: T.Text -> T.Text -> SewageAutorInfo
+sigWithChan' thechannel originallocation = GenericStyleAutor originallocation myPluginName thechannel
+
+rEPL :: TCLInterpreterWrapper -> Manhole -> IO b
 rEPL wrappedtclinterp manhole =
   let inspectManhole = atomically . readTChan . getInputChan
       regift g = atomically . (flip writeTChan g) . getOutputChan in
@@ -178,16 +182,13 @@ rEPL wrappedtclinterp manhole =
         case hmm of
           Nothing -> do
             let theOriginalChannel = getContext . nsAutorToGenericAutor . getSewageAutor $ newGift
+                theOriginalPlugin = getLocation . 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 (sigWithChan theOriginalChannel) processedGift) manhole
+            regift (Sewage (sigWithChan' theOriginalChannel theOriginalPlugin) processedGift) manhole
           Just berror -> regift (Sewage mySignature (T.pack berror)) manhole
       Nothing -> return ()
 
--- stolen from the internet and adapted for tcl
--- Return whether a string contains balanced brackets.  Nothing indicates a
--- balanced string, while (Just i) means an imbalance was found at, or just
--- after, the i'th bracket.  We assume the string contains only brackets.
 isBalanced :: Char -> Char -> String -> Maybe String
 isBalanced openc closec = bal (-1) 0
   where
@@ -202,9 +203,12 @@ isBalanced openc closec = bal (-1) 0
           (sc:rs) -> if sc == openc || sc == closec then bal (i+2) n rs else bal (i+1) n rs 
       | otherwise = bal (i+1) n bs    
 
+gnarlyBalanced :: String -> Maybe String
 gnarlyBalanced = isBalanced '{' '}'
 -- it's better not to check for double quotes and square brackets I think since they can be escaped and not used internally for pub:tcl:perform...
 
+squareBalanced :: String -> Maybe String
 squareBalanced = isBalanced '[' ']'
 
+dquoteBalanced :: String -> Maybe String
 dquoteBalanced = isBalanced '"' '"'

src/GypsFulvus.hs

@@ -68,12 +68,15 @@ lookupManholeInSewer s p = do
 
 corePlugName :: T.Text
 corePlugName = "core"
+
+mySignature :: SewageAutorInfo
 mySignature = GenericStyleAutor corePlugName "local" "local"
 
 isIOPlugin :: Sewage -> TMVar IOPIDS -> IO Bool
-isIOPlugin sewage iopids = let pname = (hash . getName .nsAutorToGenericAutor . getSewageAutor $ sewage)
+isIOPlugin sewage iopids = let pname = (hash . getLocation .nsAutorToGenericAutor . getSewageAutor $ sewage)
                     in do
   IOPIDS iop <- atomically $ readTMVar iopids
+
   return $ pname `elem` iop
 
 runForever :: TMVar Sewer -> TMVar(CommandMap) -> TMVar(IOPIDS) -> IO ()
@@ -91,7 +94,7 @@ runForever s cmap iopids =
        if (amIIO) then
          trySendToWorker s someGarbage cmap
        else do
-         pm <- atomically $ lookupManholeInSewer s "IRC-Simple"
+         pm <- atomically $ lookupManholeInSewer s (getName . nsAutorToGenericAutor . getSewageAutor $ someGarbage)
          case pm of
            Just pm -> regiftToWorker someGarbage pm
            Nothing -> return ()
@@ -125,24 +128,42 @@ makeManhole s p = do
     Nothing -> return Nothing
 
 
-tryRegisterPlugin :: TMVar(Sewer) -> T.Text -> (Manhole -> IO InitStatus) -> [T.Text] -> IO InitStatus
+
-tryRegisterPlugin s plugName initFunc tellCommandsFunc = do
+registerPlugin_
-  im <- makeManhole s plugName
+  :: TMVar Sewer
-  case im of
+     -> T.Text -> (Manhole -> IO InitStatus) -> IO InitStatus
-    Just im' -> do
+registerPlugin_ s plugName initFunc = do
-      moduleInitStatus <- initFunc im'
+      im <- makeManhole s plugName
-      case moduleInitStatus of
+      case im of
-        GoodInitStatus -> do
+        Just im' -> do
-          atomically $ assCallbackWithManholeInSewer s plugName im'
+          moduleInitStatus <- initFunc im'
-          return GoodInitStatus
+          case moduleInitStatus of
-        BadInitStatus errs -> return $ BadInitStatus $ "couldn't load the " ++ plugName ++ " plugin: " ++ errs
+            GoodInitStatus -> do
-    Nothing -> return $ BadInitStatus $ T.pack "Catastrophic failure - core ejected."
+              atomically $ assCallbackWithManholeInSewer s plugName im'
+              return GoodInitStatus
+            BadInitStatus errs -> return $ BadInitStatus $ "couldn't load the " ++ plugName ++ " plugin: " ++ errs
+        Nothing -> return $ BadInitStatus $ T.pack "Catastrophic failure - core ejected."
 
 
+tryRegisterPlugin
+  :: TMVar Sewer
+     -> TMVar IOPIDS -> TMVar CommandMap -> CarrionPlugin -> IO InitStatus
+tryRegisterPlugin s iopids commandMap plugin = do
+  let plugName = tellPlugName plugin
+  let initFunc = initPlugin plugin
+  let tellFunc = tellCommands plugin
+  theStatus <- registerPlugin_ s plugName initFunc
+  atomically $ registerCommands commandMap plugName tellFunc
+  case plugin of
+    InputPlugin initFunc tellFunc plugName -> do
+      atomically $ regiop plugName iopids
+      return ()
+    WorkerPlugin _ _ _ -> return ()
+  return theStatus
 makeNewSewer :: Manhole -> IO (TMVar Sewer)
 makeNewSewer coreManhole = do
   let
-    plugName = "core"
+    plugName = corePlugName
   emptySewer <- atomically $ newTMVar $ Sewer M.empty
   atomically $ assCallbackWithManholeInSewer (emptySewer) corePlugName coreManhole
 
@@ -156,24 +177,28 @@ stdioPlugName = "STDIO haskeline"
 
 tclPlugName :: T.Text
 tclPlugName = "TCL-Simple"
+
 ircPlugName :: T.Text
 ircPlugName = "IRC-Simple"
 
+statusBad s = case s of
+  GoodInitStatus -> False
+  BadInitStatus _ -> True
+
 execMain :: IO ()
 execMain = do
+  let cpstdio = InputPlugin CPISTDIO.initPlugin CPISTDIO.tellCommands CPISTDIO.myPlugName
+      ircsimp = InputPlugin IRCSIMP.initPlugin IRCSIMP.tellCommands IRCSIMP.myPlugName
+      tclsimp = WorkerPlugin TCLSIMP.initPlugin TCLSIMP.tellCommands TCLSIMP.myPlugName
+      myPlugins = [cpstdio,ircsimp,tclsimp]
   collectorChannel <- atomically newTChan -- normal channel for dumping any user input, this is the output channel for all plugins
   dumperChannel <- atomically newTChan -- uh this doesnt make any sense, every dings needs to have its own channel
   commandMap <- atomically $ newTMVar $ CommandMap M.empty
   iopids <- atomically $ newTMVar $ IOPIDS []
   newSewer <- makeNewSewer $ Manhole collectorChannel dumperChannel
-  tryRegisterPlugin newSewer stdioPlugName CPISTDIO.initPlugin CPISTDIO.tellCommands
+  initStatuses <- Par.mapM (tryRegisterPlugin newSewer iopids commandMap ) myPlugins
-  atomically $ registerCommands commandMap stdioPlugName CPISTDIO.tellCommands
+  let badstatuses = filter (statusBad) initStatuses
-  atomically $ regiop stdioPlugName iopids
+  if (not . null $ badstatuses) then mapM_ (putStrLn . T.pack . show) initStatuses >> error (T.unpack "Plugin load failed, see above.") else return ()
-  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  = []
   runForever newSewer commandMap iopids
   mapM_ killThread myTIDs

src/GypsFulvus/PluginStuff.hs

@@ -1,5 +1,5 @@
 {-# LANGUAGE OverloadedStrings #-}
-module GypsFulvus.PluginStuff(Sewage(..), Manhole(..), InitStatus(..), SewageAutorInfo(..), IrcMask(..), genericAutorToNSAutor, nsAutorToGenericAutor, inspectManhole, regift, stripCommandPrefix', regiftToWorker) where
+module GypsFulvus.PluginStuff(Sewage(..), Manhole(..), InitStatus(..), SewageAutorInfo(..), IrcMask(..), genericAutorToNSAutor, nsAutorToGenericAutor, inspectManhole, regift, stripCommandPrefix', regiftToWorker, Carrion(..),CarrionPlugin(..)) where
 import Control.Monad
 
 
@@ -26,7 +26,9 @@ stripCommandPrefix'
 stripCommandPrefix' c ccs m sig = case stripCommandPrefix c ccs of
   Right c -> return c
   Left cs -> do
-    sew <- regift (Sewage sig (if L.null cs then ("No such command: " ♯ c) else ("Found multiple matching commands: " ♯ ((L.foldr1 (\h ng  -> h ♯ ", " ♯ ng)) $ (map (fromMaybe "")) cs)))) m
+    sew <- do
+      putStrLn . show $ (Sewage sig (if L.null cs then ("No such command: " ♯ c) else ("Found multiple matching commands: " ♯ ((L.foldr1 (\h ng  -> h ♯ ", " ♯ ng)) $ (map (fromMaybe "")) cs))))
+      return Nothing
     return Nothing
 
 tp :: String -> T.Text
@@ -74,11 +76,11 @@ makeNetworkIdentStyleAutor n i h c = NetworkIdentStyleAutor n (IrcMask i h) c
 data Sewage = Sewage {
   getSewageAutor :: SewageAutorInfo,
   getSewage :: T.Text
-              }
+              } deriving Show
 data Manhole = Manhole {
                        getInputChan :: TChan Sewage,
                        getOutputChan :: TChan Sewage}
-data InitStatus = GoodInitStatus | BadInitStatus T.Text
+data InitStatus = GoodInitStatus | BadInitStatus T.Text deriving Show
 
 inspectManhole :: Manhole -> IO Sewage
 inspectManhole = atomically . readTChan . getInputChan
@@ -88,3 +90,14 @@ regift g = atomically . (flip writeTChan g) . getOutputChan
 
 regiftToWorker :: Sewage -> Manhole -> IO ()
 regiftToWorker g = atomically . (flip writeTChan g) . getInputChan
+
+data CarrionPlugin = InputPlugin {getInitPlugin :: (Manhole -> IO InitStatus), getTellCommands :: [T.Text], getMyPlugName :: T.Text} | WorkerPlugin {getInitPlugin :: (Manhole -> IO InitStatus), getTellCommands :: [T.Text], getMyPlugName :: T.Text}
+
+class Carrion a where
+  initPlugin :: a -> Manhole -> IO InitStatus
+  tellCommands :: a -> [T.Text]
+  tellPlugName :: a -> T.Text
+instance Carrion CarrionPlugin where
+  initPlugin = getInitPlugin
+  tellCommands = getTellCommands
+  tellPlugName = getMyPlugName

src/smeggdrop/smeggdrop.tcl

@@ -1,6 +1,7 @@
 # smeggdrop.tcl
 encoding system utf-8
 set SMEGGDROP_ROOT [file dirname [info script]]
+lappend auto_path ./tclcurl-fa
 proc putlog args {}
 if [file exists smeggdrop.conf] {source smeggdrop.conf}
 source $SMEGGDROP_ROOT/smeggdrop/smeggdrop.tcl

src/smeggdrop/smeggdrop/interpx.tcl

@@ -209,7 +209,7 @@ method {inspect proc} proc {
   }
 
   method trace_command_for_var var {
-    list ::interpx::touched_var $private_key $var
+    #list ::interpx::touched_var $private_key $var
   }
 
   # callbacks
@@ -343,7 +343,7 @@ method {inspect proc} proc {
     $self . namespace eval ::interpx {}
     $interp alias ::interpx::noop expr 0
     $interp alias ::interpx::timeout ::interpx::timeout
-    $self expose {did touch var} ::interpx::touched_var
+      $self expose {did touch var} ::interpx::touched_var
     
   }
   

src/smeggdrop/smeggdrop/versioned_interpreter.tcl

@@ -81,14 +81,19 @@ snit::type versioned_interpreter {
     log "Loading interpreter state..."
 
     set script {}
-    lappend script [$self read_procs_from_repository]
+
     set fn [$self path "stolen-treasure.tcl"]
     set ff [open $fn r]
     fconfigure $ff -encoding utf-8
     set fuku [read $ff]
     set hng [split $fuku "\n"]
     lappend script {*}$hng
+    set english_words_f [open [$self path "english_words.txt"] r]
+    set english_words [split [read $english_words_f] "\n"]
+    lappend script "set english_words [list $english_words]"
+    lappend script [$self read_procs_from_repository]
     lappend script [$self read_vars_from_repository]
+
 #    puts [join $script \n]
 # good luck curating this turd, I give up
     $interpx eval -notimeout [join $script \n]
@@ -366,7 +371,7 @@ snit::type versioned_interpreter::index {
   }
   
   method get key {
-    set values($key)
+    if [catch {set values($key)} fuckyou] {$self put $key [sha1 $key]; return [sha1 $key]} {return $fuckyou}
   }
   
   method delete key {

stack.yaml

@@ -28,6 +28,12 @@ resolver: lts-16.13
 #   subdirs:
 #   - auto-update
 #   - wai
+nix:
+  enable: true
+  packages:
+    - "zlib"
+    - "tcl"
+
 packages:
 - .
 # Dependency packages to be pulled from upstream that are not in the resolver.

state

@@ -1 +1 @@
-Subproject commit 45e92f9730be1928fec14edcf5a653dec05a265c
+Subproject commit 57a2107ec4e8fb1238a2c66d57931cf69b3f1efc

tclcurl-fa

@@ -1 +1 @@
-Subproject commit bfba40e566eea65a9171f6f943c78958ffe0509d
+Subproject commit dda5a73bdaad3c8f4ab023b7bcdf98858b3bb5a8