Question

我需要启动一个长时间运行的过程。它需要几秒钟才能启动，并将日志输出到stdout，其中一个表明它已准备就绪。

我想：

以静默方式启动进程，以便进程中的stdout不会显示在我的会话中。
在流输出时捕获输出，以便我可以确定它已准备就绪。
对流程有一些处理，以便我可以在以后停止流程。

我已经接近使用Shelly，Turtle和System.Process，但未能捕获标准输出。

使用System.Process我有：

import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (race)
import System.IO
import System.Process

startService :: IO ProcessHandle
startService = do
  let cmd = "./my-service"
      args = [ "-p 1234" ]
  (_, Just hout, _, p) <- createProcess $ (proc cmd args) { std_out = CreatePipe }
  started <- either id id <$> race (checkStarted hout) timeOut
  unless started $ fail "Service not started"
  pure p
  where
    checkStarted :: Handle -> IO Bool
    checkStarted h = do
      str <- hGetLine h
      -- check str for started log, else loop

    timeOut :: IO Bool
    timeOut = do
      threadDelay 10000000
      pure False

但处理程序hout从未处于就绪状态。

使用Shelly我有：

import Control.Concurrent (threadDelay)
import Control.Concurrent.Async (race)
import Control.Concurrent.MVar
import Shelly
import System.IO

startService :: IO (Async ())
startService = do
  let cmd = "./my-service"
      args = [ "-p 1234" ]
  startedMVar <- newEmptyMVar
  async <- shelly $ asyncSh $ runHandle cmd args $ recordWhenStarted startedMVar
  started <- either id id <$> race (readMVar startedMVar) timeOut
  unless started $ fail "Service not started"
  pure async
  where
    recordWhenStarted :: MVar Bool -> Text -> IO ()
    recordWhenStarted mvar txt =
      when (isStartedLog txt) $
        modifyMVar_ mvar (const $ pure True)

    timeOut :: IO Bool
    timeOut = do
      threadDelay 10000000
      pure False

但永远不会调用recordWhenStarted。

Answer 1

以下是启动流程和阅读stdout in a program of mine的示例：

  runMystem :: [T.Text] -> IO T.Text
  runMystem stemWords = do
    (i, o, _, ph) <- createProcess (proc mystemExecutabe mystemParams) { std_in = CreatePipe, std_out = CreatePipe }
    res <- flip (maybe (return T.empty)) i $ \hIn ->
              flip (maybe (return T.empty)) o $ \hOut -> do
                hSetEncoding hIn utf8
                hSetEncoding hOut utf8
                forM_ stemWords $ TIO.hPutStrLn hIn
                TIO.hGetContents hOut
    void $ waitForProcess ph
    return res

Answer 2

这个答案使用process-streaming库（由本答案的作者撰写），这是一组process上的助手。

{-# language OverloadedStrings #-}
{-# language NumDecimals #-}
import           System.Process.Streaming (execute,piped,shell,foldOut,transduce1)
import qualified System.Process.Streaming.Text as PT
import           Data.Text.Lazy (isInfixOf)
import           Control.Applicative
import           Control.Monad
import           Control.Concurrent (threadDelay)
import           Control.Concurrent.Async
import           Control.Concurrent.MVar

main :: IO ()
main = do
    started <- newEmptyMVar
    let execution =
            execute (piped (shell "{ sleep 3 ; echo fooo ; sleep 3 ; }")) $
                foldOut . transduce1 PT.utf8x . PT.eachLine $ lookline
        lookline line = do
            when (isInfixOf "foo" line) (putMVar started ())
            return (Right ())
        stopOrNot =
            do abort <- race (threadDelay 4e6) (readMVar started)
               case abort of
                   Left () -> return () -- stop immediately
                   Right () -> runConcurrently empty -- sleep forever
    result <- race stopOrNot execution
    print result

execute安装异常处理程序，在异步异常到达时终止外部进程，使用race可以安全地使用它。

execute还会耗尽任何未明确读取的标准流（在本例中为 stderr ），以避免常见的死锁源。

Haskell：开始一个长时间运行的进程，默默地捕获stdout

2 个答案: