haskell - 为什么 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 容器是否都已创建然后删除。

但是，如果我将完全相同的代码粘贴到测试中并运行 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 中，SIGINT 信号仅传送到 bracket-test-exe过程。这会引发异步 UserInterrupt异常(exception)。一路 bracket工作，当:

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

在处理 body 时收到异步异常, 它运行 release然后重新引发异常。与您的嵌套 bracket调用，这具有中断内部体，处理内部释放，重新引发异常中断外部体，处理外部释放，最后重新引发异常终止程序的效果。 (如果在 bracket 函数中的外部 main 之后还有更多操作，它们将不会被执行。)

另一方面，当您使用 stack test , 堆栈使用 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 相比，这不会引发异步异常。它只是立即终止子进程，通常是在它完成运行任何终结器之前。

我想不出一个特别简单的方法来解决这个问题。一种方法是使用 System.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 提示时，该过程会在后台进行清理。