3

我有一个带有经纱服务器的 Yesod 应用程序，它的一些功能取决于异步异常。最近出现了将其迁移到 https 的需要，我使用 package 进行了迁移warp-tls。但是现在我不能通过向ThreadKilled它抛出异常来杀死扭曲线程，该throwTo函数只是挂起并且什么都不做。

考虑以下示例。这里我们用 监控warp线程的状态，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 线程？

4

1 回答 1

3

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

于 2019-08-26T07:08:31.573 回答