pms-infra-cmdrun 0.0.3.0 → 0.0.4.0
raw patch · 4 files changed
+55/−10 lines, 4 files
Files
- CHANGELOG.md +4/−0
- pms-infra-cmdrun.cabal +1/−1
- src/PMS/Infra/CmdRun/DS/Core.hs +8/−5
- src/PMS/Infra/CmdRun/DS/Utility.hs +42/−4
CHANGELOG.md view
@@ -1,5 +1,9 @@ # Revision history for pms-infra-cmdrun +## 0.0.4.0 -- 2025-07-20++* Added proc tool.+ ## 0.0.3.0 -- 2025-07-13 * Added serial tool.
pms-infra-cmdrun.cabal view
@@ -20,7 +20,7 @@ -- PVP summary: +-+------- breaking API changes -- | | +----- non-breaking API additions -- | | | +--- code changes with no API change-version: 0.0.3.0+version: 0.0.4.0 -- A short (one-line) description of the package. synopsis: pms-infra-cmdrun
src/PMS/Infra/CmdRun/DS/Core.hs view
@@ -25,6 +25,7 @@ import qualified PMS.Domain.Model.DM.Type as DM import qualified PMS.Domain.Model.DM.Constant as DM+import qualified PMS.Domain.Model.DS.Utility as DM import PMS.Infra.CmdRun.DM.Type import PMS.Infra.CmdRun.DS.Utility@@ -56,16 +57,18 @@ -- cmd2task :: ConduitT DM.CmdRunCommand (IOTask ()) AppContext () cmd2task = await >>= \case- Just cmd -> flip catchError errHdl $ do+ Just cmd -> flip catchError (errHdl cmd) $ do lift (go cmd) >>= yield >> cmd2task Nothing -> do $logWarnS DM._LOGTAG "cmd2task: await returns nothing. skip." cmd2task where- errHdl :: String -> ConduitT DM.CmdRunCommand (IOTask ()) AppContext ()- errHdl msg = do+ errHdl :: DM.CmdRunCommand -> String -> ConduitT DM.CmdRunCommand (IOTask ()) AppContext ()+ errHdl cmdCmd msg = do+ let jsonrpc = DM.getJsonRpcCmdRunCommand cmdCmd $logWarnS DM._LOGTAG $ T.pack $ "cmd2task: exception occurred. skip. " ++ msg+ lift $ errorToolsCallResponse jsonrpc $ "cmd2task: exception occurred. skip. " ++ msg cmd2task go :: DM.CmdRunCommand -> AppContext (IOTask ())@@ -147,8 +150,8 @@ argsBS = DM.unRawJsonByteString $ dat^.DM.argumentsDefaultCmdRunCommandData args <- liftEither $ eitherDecode $ argsBS - name <- validateCommand nameTmp- argsStr <- validateCommandArg $ args^.argumentsStringToolParams+ name <- liftIOE $ DM.validateCommand nameTmp+ argsStr <- liftIOE $ DM.validateArg $ args^.argumentsStringToolParams #ifdef mingw32_HOST_OS let scriptExt = ".bat" #else
src/PMS/Infra/CmdRun/DS/Utility.hs view
@@ -7,9 +7,9 @@ import Control.Monad.IO.Class import Control.Monad.Except import Control.Monad.Reader-import qualified Data.Text as T-import Data.Char-import Control.Monad+import qualified Control.Concurrent.STM as STM+import System.Exit+import Control.Lens import qualified PMS.Domain.Model.DM.Type as DM import qualified PMS.Domain.Model.DS.Utility as DM@@ -36,7 +36,7 @@ errHdl :: E.SomeException -> IO (Either String a) errHdl = return . Left . show -+{- -- | -- validateCommand :: String -> AppContext String@@ -101,4 +101,42 @@ forbiddenCommands :: [String] forbiddenCommands = ["rm", "mv", "dd", "chmod", "chown", "shutdown", "reboot", "kill", "nc", "telnet", "ssh"]+-}++-- |+--+toolsCallResponse :: STM.TQueue DM.McpResponse+ -> DM.JsonRpcRequest+ -> ExitCode+ -> String+ -> String+ -> IO ()+toolsCallResponse resQ jsonRpc code outStr errStr = do+ let content = [ DM.McpToolsCallResponseResultContent "text" outStr+ , DM.McpToolsCallResponseResultContent "text" errStr+ ]+ result = DM.McpToolsCallResponseResult {+ DM._contentMcpToolsCallResponseResult = content+ , DM._isErrorMcpToolsCallResponseResult = (ExitSuccess /= code)+ }+ resDat = DM.McpToolsCallResponseData jsonRpc result+ res = DM.McpToolsCallResponse resDat++ STM.atomically $ STM.writeTQueue resQ res+++-- |+--+errorToolsCallResponse :: DM.JsonRpcRequest -> String -> AppContext ()+errorToolsCallResponse jsonRpc errStr = do+ let content = [ DM.McpToolsCallResponseResultContent "text" errStr ]+ result = DM.McpToolsCallResponseResult {+ DM._contentMcpToolsCallResponseResult = content+ , DM._isErrorMcpToolsCallResponseResult = True+ }+ resDat = DM.McpToolsCallResponseData jsonRpc result+ res = DM.McpToolsCallResponse resDat++ resQ <- view DM.responseQueueDomainData <$> lift ask+ liftIOE $ STM.atomically $ STM.writeTQueue resQ res