如何在处理下一个请求之前强制 yesod/warp 关闭打开的文件句柄？

Question

我编写了一个小型服务器，它接受作为 POST 请求的注册并通过将它们附加到文件来持久化它们。一旦我将此服务器置于负载状态（我使用具有 50 个并发线程和 10 个重复计数的 Apache JMeter，并且帖子包含一个包含约 7k 文本数据的字段），我就会得到很多“资源繁忙，文件是锁定”错误：

02/Nov/2013:18:07:11 +0100 [Error#yesod-core] registrations.txt: openFile: resource busy (file is locked) @(yesod-core-1.2.4.2:Yesod.Core.Class.Yesod ./Yesod/Core/Class/Yesod.hs:485:5)

这是代码的精简版：

{-# LANGUAGE QuasiQuotes, TemplateHaskell, MultiParamTypeClasses, OverloadedStrings, TypeFamilies #-}

import           Yesod
import           Text.Hamlet
import           Control.Applicative ((<$>), (<*>))
import           Control.Monad.IO.Class (liftIO)
import           Data.Text (Text, pack, unpack)
import           Data.String
import           System.IO (withFile, IOMode(..), hPutStrLn)

data Server = Server

data Registration = Registration
        { text      :: Text
        }
    deriving (Show, Read)

mkYesod "Server" [parseRoutes|
/reg    RegR    POST
|]

instance Yesod Server

instance RenderMessage Server FormMessage where
    renderMessage _ _ = defaultFormMessage

postRegR :: Handler Html
postRegR = do
    result <- runInputPost $ Registration
        <$> ireq textField "text"
    liftIO $ saveRegistration result
    defaultLayout [whamlet|<p>#{show result}|]

saveRegistration :: Registration -> IO ()
saveRegistration r = withFile "registrations.txt" AppendMode (\h -> hPutStrLn h $ "+" ++ show r)

main :: IO ()
main = warp 8080 Server

我故意在没有-threaded 的情况下编译了代码，操作系统显示只有一个线程在运行。尽管如此，在我看来，请求并未完全序列化，并且在旧请求写入磁盘之前已经处理了新请求。

您能告诉我如何避免错误消息并确保所有请求都得到成功处理吗？性能还不是问题。

Answer 1

从多个线程写入Handle 是完全可以的。事实上，Handles 内部有 MVars 以防止奇怪的并发行为。您可能想要的不是手动处理 [原文如此] MVars（例如，如果处理程序抛出异常，这可能会导致死锁），而是在各个处理程序线程之外解除 withFile 调用。该文件始终保持打开状态 - 每次请求打开它都会很慢。

我对 Yesod 了解不多，但我会推荐这样的东西（可能无法编译）：

data Server = Server { handle :: Handle }

postRegR :: Handler Html
postRegR = do
    h <- handle `fmap` getYesod
    result <- runInputPost $ Registration
        <$> ireq textField "text"
    liftIO $ saveRegistration h result
    defaultLayout [whamlet|<p>#{show result}|]

saveRegistration :: Handle -> Registration -> IO ()
saveRegistration h r = hPutStrLn h $ "+" ++ show r

main :: IO ()
main = withFile "registrations.txt" AppendMode $ \h -> warp 8080 (Server h) 
-- maybe there's a better way?

除此之外：如果您想异步写入文件，您可以写入队列（如果它是日志文件或其他内容），但在您的用例中，您可能希望让用户知道他们的注册是否失败，所以我建议您使用此表单。

Answer 2

即使没有-threaded，Haskell 运行时也会有几个“绿色线程”协同运行。您需要使用Control.Concurrent 来限制对文件的访问，因为您不能有多个线程同时写入它。

最简单的方法是在您的Server 中添加一个MVar ()，并让每个请求在打开文件之前从MVar“获取”单元，然后在文件操作完成后将其放回原处。您可以使用bracket 确保即使写入文件失败也会释放锁定。例如。像

import Control.Concurrent
import Control.Exception (bracket_)

type Lock = MVar ()
data Server = Server { fileLock :: Lock }

saveRegistration :: Registration -> Lock -> IO ()
saveRegistration r lock = bracket_ acquire release updateFile where
    acquire = takeMVar lock
    release = putMVar lock ()
    updateFile =
        withFile "registrations.txt" AppendMode (\h -> hPutStrLn h $ "+" ++ show r)