multithreading - throwTo 扭曲 tls 线程 idefinetly 挂起

Question

我有一个带有扭曲服务器的 Yesod 应用程序，它的一些功能取决于异步异常。最近需要将它迁移到 https，我用包 warp-tls 做到了这一点。 .但是现在我不能通过抛出 ThreadKilled 来杀死经线异常(exception)，throwTo函数只是挂起，什么也不做。

考虑以下示例。这里我们用MVar ()监控经线的状态，在线程运行时为空，在线程被杀死时为 () 值。

import MyApplication (waiPage)
-- waiPage :: Application

runWai :: MVar () -> IO ()
runWai finishVar = bracket
  (return ())
  (const $ putMVar finishVar ())
  (const runApp)
  where
    -- change this to normal or tls to check
    runApp = runAppTls
    runAppNormal = runSettings warpSettings waiPage
    runAppTls = runTLS siteTlsSettings warpSettings waiPage
    --
    warpSettings = setPort 8080 defaultSettings
    siteTlsSettings = tlsSettings "cert.pem" "key.pem"



main :: IO ()
main = do
  finishVar <- newEmptyMVar
  thread_id <- forkIO $ runWai finishVar
  -- Try to kill warp thread. Fork because throw might hang
  forkIO $ throwTo thread_id ThreadKilled
  threadDelay (2 * 10^6) -- microseconds to seconds
  isAlive <- isEmptyMVar finishVar
  if isAlive then putStrLn "Couldn't kill warp thread"
             else putStrLn "Succesfully killed warp thread"
  -- Wait for forked warp thread to finish
  readMVar finishVar

当您有 runApp = runAppNormal , 你会得到 Succesfully killed warp thread消息，应用程序将退出。

当您有 runApp = runAppTls ，您将获得 Couldn't kill warp thread消息，应用程序将挂起并继续服务。

那么如何摆脱这种异常拦截行为呢？或者至少有没有办法以任何其他方式杀死 warpTls 线程？

Answer 1

结果证明是我使用的版本中的一个仅限 Windows 的错误，即 warp-tls == 3.2.4在以后的版本中得到了修复。我查看了修复程序，它是一个名为 windowsThreadBlockHack 的函数。 ，因此如果有人遇到过时的扭曲，您也可以为您反向移植此修复程序。