How to force yesod/warp to close open file handles before handling next request?

Question

I've written a small server which accepts registrations as POST requests and persists them by appending them to a file. As soon as I put this server under load (I use Apache JMeter with 50 concurrent threads and a repeat count of 10, and the post consists of one field with ~7k of text data), I get lots of "resource busy, file is locked" errors:

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)

Here is a stripped-down version of the code:

{-# 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

I compiled the code on purpose without -threaded, and the OS shows only a single thread running. Nonetheless it looks to me like the requests are not completely serialised, and a new request is already handled before the old one has been written to disk.

Could you tell me how I can avoid the error message and ensure that all requests are handled successfully? Performance is not an issue yet.

Fixnum · Answer 1 · 2013-11-02T23:20:18.037

4

It's perfectly OK to write to a Handle from several threads. In fact, Handles have MVars inside them to prevent weird concurrent behaviour. What you probably want is not to handle [sic] MVars by hand (which can lead to deadlock if, for instance, a handler throws an exception) but lift the withFile call outside the individual handler threads. The file stays open all the time - opening it on each request would be slow anyway.

I don't know much about Yesod, but I'd recommend something like this (probably doesn't compile):

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?

Aside: if you wanted to file to be written asynchronously you could write to a queue (if it were a log file or something), but in your use case you probably want to let the user know if their registration failed, so I'd recommend staying with this form.

edited Nov 02 '13 at 23:20

answered Nov 02 '13 at 18:51

Fixnum

1,842
1
13
25

As a first try I've used your example but left the `withFile` in the `saveRegistration` function and passed it an `MVar`. Then I've surrounded the `hPutStrLn` with a `takeMVar` / `putMVar` and I've had no errors in hundreds of requests! In order to avoid the deadlock you described, I've also tried to put the `putMVar` inside the handler function in `withFile`, but surprisingly that didn't work. Finally I've tried your solution and it is indeed faster. Thank you very much for the detailed example! – Axel Hanikel Nov 03 '13 at 10:56
Taking locks *inside* the `withFile` (if I understand you) doesn't work because your error results from trying to *open* an already open file, which is caused by `withFile` itself. Sorry if that wasn't clear. – Fixnum Nov 03 '13 at 17:10
Ah, of course, now that you say it, it makes perfect sense! I hope you don't mind that I've marked shang's answer as the accepted one: your solution is more efficient but it completely avoids the problem , whereas shang's answer contains an explanation of the unexpected behaviour, and a generic solution to it which might also be applicable to other people's code. Thank you so much, I've learned a lot from both your answers! – Axel Hanikel Nov 04 '13 at 08:34

shang · Accepted Answer · 2013-11-03T17:13:53.363

3

Even without -threaded the Haskell runtime will have several "green threads" running cooperatively. You need to use Control.Concurrent to limit access to the file because you cannot have several threads writing to it at once.

The easiest way is to have an MVar () in your Server and have each request "take" the unit from the MVar before opening the file and then put it back after the file operation has been completed. You can use bracket to ensure that the lock is released even if writing the file fails. E.g. something like

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)

edited Nov 03 '13 at 17:13

answered Nov 02 '13 at 18:06

shang

24,642
3
58
86

To clarify: it's perfectly OK to write to a `Handle` from several threads - `Handle`s have `MVar`s inside them to prevent weird concurrent behaviour. What you probably want is not to handle `MVar`s by hand (which can lead to deadlock if a handler throws an exception) but lift the `withFile` outside the individual threads. The file stays open, but that's probably inevitable (opening it on each request would be slow anyway). – Fixnum Nov 02 '13 at 18:30
Fixnum: That's actually a much better way. You should put that as an answer. :) – shang Nov 02 '13 at 18:43
Unfortunately I can't mark both yours and Fixnum's answers as accepted, because a combination of both solved my problem perfectly: I've used an MVar as you described, and Fixnum's example showed me how to do it. Thank you!!! – Axel Hanikel Nov 03 '13 at 09:48
@AxelHanikel: I added a short example which uses `bracket`. Without that any errors that might happen when updating the file would leave the `MVar` empty and the application deadlocked. – shang Nov 03 '13 at 17:16
I've tried to use `bracket` as well but your example is a lot more readable than what I did, so I'll remember it not only for the functionality but also as an example for writing code that is easy to read. I'll mark this answer as the accepted answer now because I think it's the most concise recipe for other newbie Haskellers running into the same problem. Thanks again! – Axel Hanikel Nov 04 '13 at 08:19

How to force yesod/warp to close open file handles before handling next request?

2 Answers2