为什么 Haskell 的括号函数在可执行文件中工作但在测试中无法清理？

Question

我看到一个非常奇怪的行为，其中 Haskell 的bracket函数根据是否使用stack run或被stack test使用而表现不同。

考虑以下代码，其中两个嵌套的括号用于创建和清理 Docker 容器：

module Main where

import Control.Concurrent
import Control.Exception
import System.Process

main :: IO ()
main = do
  bracket (callProcess "docker" ["run", "-d", "--name", "container1", "registry:2"])
          (\() -> do
              putStrLn "Outer release"
              callProcess "docker" ["rm", "-f", "container1"]
              putStrLn "Done with outer release"
          )
          (\() -> do
             bracket (callProcess "docker" ["run", "-d", "--name", "container2", "registry:2"])
                     (\() -> do
                         putStrLn "Inner release"
                         callProcess "docker" ["rm", "-f", "container2"]
                         putStrLn "Done with inner release"
                     )
                     (\() -> do
                         putStrLn "Inside both brackets, sleeping!"
                         threadDelay 300000000
                     )
          )

当我用 运行它stack run并用 中断时Ctrl+C，我得到了预期的输出：

Inside both brackets, sleeping!
^CInner release
container2
Done with inner release
Outer release
container1
Done with outer release

我可以验证两个 Docker 容器是否已创建然后被删除。

但是，如果我将此完全相同的代码粘贴到 test 中并运行stack test，则只会发生（部分）第一次清理：

Inside both brackets, sleeping!
^CInner release
container2

这导致 Docker 容器在我的机器上运行。这是怎么回事？

• 我已经确保完全相同ghc-options的传递给两者。
• 完整的演示仓库在这里：https : //github.com/thomasjm/bracket-issue

Answer 1

当您使用 时stack run，Stack 有效地使用exec系统调用将控制权转移到可执行文件，因此新可执行文件的进程替换了正在运行的 Stack 进程，就像您直接从 shell 运行可执行文件一样。这是进程树在 之后的样子stack run。请特别注意，可执行文件是 Bash shell 的直接子级。更关键的是，请注意终端的前台进程组 (TPGID) 是 17996，并且该进程组 (PGID) 中唯一的进程是该bracket-test-exe进程。

PPID   PID  PGID   SID TTY      TPGID STAT   UID   TIME COMMAND
13816 13831 13831 13831 pts/3    17996 Ss    2001   0:00  |       \_ /bin/bash --noediting -i
13831 17996 17996 13831 pts/3    17996 Sl+   2001   0:00  |       |   \_ .../.stack-work/.../bracket-test-exe

因此，当您按 Ctrl-C 中断stack run在 shell下或直接从 shell运行的进程时，SIGINT 信号仅传递给该bracket-test-exe进程。这会引发异步UserInterrupt异常。该方法bracket有效，当：

bracket
  acquire
  (\() -> release)
  (\() -> body)

在处理时收到一个异步异常body，它运行release然后重新引发异常。对于您的嵌套bracket调用，这具有中断内部主体，处理内部释放，重新引发异常以中断外部主体，并处理外部释放，最后重新引发异常以终止程序的效果。（如果bracket在您的main函数的外部后面有更多操作，它们将不会被执行。）

另一方面，当您使用 时stack test，Stack 用于withProcessWait将可执行文件作为进程的子进程启动stack test。在下面的进程树中，请注意它bracket-test-test是 的子进程stack test。关键是，终端的前台进程组是 18050，该进程组包括stack test进程和bracket-test-test进程。

PPID   PID  PGID   SID TTY      TPGID STAT   UID   TIME COMMAND
13816 13831 13831 13831 pts/3    18050 Ss    2001   0:00  |       \_ /bin/bash --noediting -i
13831 18050 18050 13831 pts/3    18050 Sl+   2001   0:00  |       |   \_ stack test
18050 18060 18050 13831 pts/3    18050 Sl+   2001   0:00  |       |       \_ .../.stack-work/.../bracket-test-test

当您在终端按Ctrl-C，SIGINT信号发送到所有进程终端的前台进程组中这样既stack test和bracket-test-test得到信号。 bracket-test-test将开始处理信号并如上所述运行终结器。然而，这里有一个竞争条件，因为当stack test被中断时，它在中间withProcessWait或多或少地定义如下：

withProcessWait config f =
  bracket
    (startProcess config)
    stopProcess
    (\p -> f p <* waitExitCode p)

因此，当它bracket被中断时，它会stopProcess通过向它发送SIGTERM信号来调用它来终止子进程。与 相比SIGINT，这不会引发异步异常。它只是立即终止子进程，通常在它完成运行任何终结器之前。

我想不出一个特别简单的方法来解决这个问题。一种方法是使用设施 inSystem.Posix将进程放入其自己的进程组：

main :: IO ()
main = do
  -- save old terminal foreground process group
  oldpgid <- getTerminalProcessGroupID (Fd 2)
  -- get our PID
  mypid <- getProcessID
  let -- put us in our own foreground process group
      handleInt  = setTerminalProcessGroupID (Fd 2) mypid >> createProcessGroupFor mypid
      -- restore the old foreground process gorup
      releaseInt = setTerminalProcessGroupID (Fd 2) oldpgid
  bracket
    (handleInt >> putStrLn "acquire")
    (\() -> threadDelay 1000000 >> putStrLn "release" >> releaseInt)
    (\() -> putStrLn "between" >> threadDelay 60000000)
  putStrLn "finished"

现在，Ctrl-C 将导致 SIGINT 仅传递给bracket-test-test进程。它将清理、恢复原始前台进程组以指向该stack test进程，然后终止。这将导致测试失败，并且stack test只会继续运行。

另一种方法是尝试处理SIGTERM并保持子进程运行以执行清理，即使该stack test进程已终止。这有点难看，因为当您查看 shell 提示时，该过程会在后台进行清理。