在终止进程时捕获输出

Question

我需要运行一个进程，在它运行时做一些事情，最后终止它。这 有问题的进程将我想保留的内容写入标准输出。很遗憾， 似乎该过程在我连接并提取其遗言之前就死了。有稀缺 有异步编程经验，我很难找到一个好的解决方案。它 如果我能在RIO.Process 的框架内完成这项任务将是幸运的，尽管我 如果无法避免，我准备走出它。 （请注意，RIO 使用了一个不寻常的 通过回调系统调用外部进程的方式。）

下面是我试图实现的高度简化的可运行示例。

这是要运行的程序的模拟：
（将其放入名为 x.sh 的文件中并说 chmod +x x.sh 以使其可执行。）

#!/bin/sh

trap 'echo "Terminating..."; exit 0' TERM

echo "Initialization complete."

while true; do sleep 1; done

这是我的代码：
（将其放入名为 X.hs 的文件中并使用 ghc -package rio X.hs 进行编译。）

{-#   language   NoImplicitPrelude   #-}
{-#   language   BlockArguments      #-}
{-#   language   OverloadedStrings   #-}

module Main where

import RIO
import RIO.Process
import Data.Text.IO (hGetContents, hGetLine)

main :: IO ()
main = runSimpleApp do
    proc "./x.sh" [ ]
        \processConfig -> withProcessWait_ (setStdout createPipe processConfig)
            \processHandle -> bracket_
                (initialize processHandle)
                (terminate processHandle)
                (return ())

initialize :: (HasProcessContext env, HasLogFunc env) => Process () Handle () -> RIO env ()
initialize processHandle = do
    x <- liftIO $ hGetLine (getStdout processHandle)
    if x == "Initialization complete." then return () else error "This should not happen."

terminate :: HasLogFunc env => Process () Handle () -> RIO env ()
terminate processHandle = do
    log' <- async $ liftIO $ hGetContents (getStdout processHandle)
    stopProcess processHandle
    log <- wait log'
    logInfo $ display log

会发生什么：

% ./X
X: fd:3: hGetBuffering: illegal operation (handle is closed)

——x.sh 正在说话，但我听不见。

管理这个问题的正确方法是什么？

Answer 1

来自the documentation for stopProcess：

关闭一个进程并释放所有获取的资源。这将确保调用terminateProcess，等待进程实际退出，然后关闭为流分配的资源。如果引发任何清理异常，这将引发异常。

（强调我的）你不希望stopProcess 在阅读输出之前这样做。你只想要terminateProcess。 withProcessWait_ 将负责其余的工作。不幸的是，您必须跳出RIO 才能做到这一点，使用import System.Process (terminateProcess) 然后liftIO $ terminateProcess (unsafeProcessHandle processHandle)。

旁注：您有点滥用bracket_。由于bracket_ 的“中间”是无操作的，尤其是现在开头和结尾实际上并没有获取或释放任何资源，所以这有点毫无意义。此外，完全不用async，您可以在终止进程后正常读取输出，因为进程已经产生的输出不会在终止时消失。

这是您的代码，上面的所有内容都已修复：

{-#   language   NoImplicitPrelude   #-}
{-#   language   BlockArguments      #-}
{-#   language   OverloadedStrings   #-}

module Main where

import RIO
import RIO.Process
import Data.Text.IO (hGetContents, hGetLine)
import System.Process (terminateProcess)

main :: IO ()
main = runSimpleApp do
    proc "./x.sh" [ ]
        \processConfig -> withProcessWait_ (setStdout createPipe processConfig)
            \processHandle -> do
                initialize processHandle
                terminate processHandle

initialize :: (HasProcessContext env, HasLogFunc env) => Process () Handle () -> RIO env ()
initialize processHandle = do
    x <- liftIO $ hGetLine (getStdout processHandle)
    if x == "Initialization complete." then return () else error "This should not happen."

terminate :: HasLogFunc env => Process () Handle () -> RIO env ()
terminate processHandle = do
    liftIO $ terminateProcess (unsafeProcessHandle processHandle)
    log <- liftIO $ hGetContents (getStdout processHandle)
    logInfo $ display log