pms-infra-cmdrun 0.0.5.0 → 0.0.6.0

raw patch · 4 files changed

+31/−8 lines, 4 files

Files

• CHANGELOG.md +4/−0
• pms-infra-cmdrun.cabal +1/−1
• src/PMS/Infra/CmdRun/DS/Core.hs +12/−7
• src/PMS/Infra/CmdRun/DS/Utility.hs +14/−0

@@ -1,5 +1,9 @@ # Revision history for pms-infra-cmdrun +## 0.0.6.0 -- 2025-08-11++* Fixed encoding.+ ## 0.0.5.0 -- 2025-07-27  * Fixed resources templates.

@@ -20,7 +20,7 @@ -- PVP summary:     +-+------- breaking API changes --                  | | +----- non-breaking API additions --                  | | | +--- code changes with no API change-version:            0.0.5.0+version:            0.0.6.0  -- A short (one-line) description of the package. synopsis:           pms-infra-cmdrun

@@ -17,11 +17,13 @@ import Control.Concurrent.Async import qualified Data.Text as T import Control.Monad.Except-import System.Process import System.FilePath import Data.Aeson import qualified Control.Exception.Safe as E import System.Exit+import qualified Data.Text.Encoding as TE+import qualified Data.Text.Encoding.Error as TEE+import qualified Data.ByteString as BS  import qualified PMS.Domain.Model.DM.Type as DM import qualified PMS.Domain.Model.DM.Constant as DM@@ -158,7 +160,7 @@   let scriptExt = ".sh" #endif -  let cmd = toolsDir </> name ++ scriptExt ++ " " ++ argsStr+  let cmd = "\"" ++ toolsDir </> name ++ scriptExt ++ "\" " ++ argsStr    $logDebugS DM._LOGTAG $ T.pack $ "cmdRunTask: system cmd. " ++ cmd   return $ cmdRunTask resQ dat cmd@@ -171,7 +173,8 @@   hPutStrLn stderr $ "[INFO] PMS.Infra.CmdRun.DS.Core.work.cmdRunTask run. " ++ cmd   let tout = 30 * 1000 * 1000 -  race (readCreateProcessWithExitCode (shell cmd) "") (CC.threadDelay tout) >>= \case+--  race (readCreateProcessWithExitCode (shell cmd) "") (CC.threadDelay tout) >>= \case+  race (runCommandBS cmd) (CC.threadDelay tout) >>= \case     Left (code, out, err)  -> response code out err     Right _ -> E.throwString "timeout occurred." @@ -179,11 +182,13 @@    where     errHdl :: E.SomeException -> IO ()-    errHdl e = response (ExitFailure 1) "" (show e)+    errHdl e = response (ExitFailure 1) "" $ TE.encodeUtf8 . T.pack $ show e -    response :: ExitCode -> String -> String -> IO ()-    response code outStr errStr = do-      let jsonRpc = cmdDat^.DM.jsonrpcDefaultCmdRunCommandData+    response :: ExitCode -> BS.ByteString -> BS.ByteString -> IO ()+    response code outBS errBS = do+      let outStr = T.unpack $ TE.decodeUtf8With TEE.lenientDecode outBS+          errStr = T.unpack $ TE.decodeUtf8With TEE.lenientDecode errBS+          jsonRpc = cmdDat^.DM.jsonrpcDefaultCmdRunCommandData           content = [ DM.McpToolsCallResponseResultContent "text" outStr                     , DM.McpToolsCallResponseResultContent "text" errStr                     ]

@@ -10,6 +10,9 @@ import qualified Control.Concurrent.STM as STM import System.Exit import Control.Lens+import System.Process+import System.IO+import qualified Data.ByteString as BS  import qualified PMS.Domain.Model.DM.Type as DM import qualified PMS.Domain.Model.DS.Utility as DM@@ -74,3 +77,14 @@   resQ <- view DM.responseQueueDomainData <$> lift ask   liftIOE $ STM.atomically $ STM.writeTQueue resQ res ++-- |+--+runCommandBS :: String -> IO (ExitCode, BS.ByteString, BS.ByteString)+runCommandBS cmd = do+    (hin, hout, herr, ph) <- runInteractiveCommand cmd+    hClose hin+    out <- BS.hGetContents hout+    err <- BS.hGetContents herr+    exitCode <- waitForProcess ph+    return (exitCode, out, err)