On Thu Nov 13 2014 at 8:58:12 AM Yuras Shumovich
On Thu, 2014-11-13 at 00:43 +0200, Eyal Lotem wrote:
-- | database that uses two files data DB = DB Handle Handle
closeDB :: DB -> IO () closeDB (DB h1 h2) = hClose h1 >> hClose h2
The cleanup action "closeDB" above is buggy because the first hClose
can
be interrupted. In that case the first handle will be closed, but the second will leak. Note: "closeDB" is not atomic -- it consists from two interruptible different actions. The same with hClose itself -- if can be interrupted somewhere in the middle, but it is able to handle that.
The correct cleanup probably should look like the next:
closeDB (DB h1 h2) = hClose h1 `finally` hClose h2
Note: the initial version is buggy with respect to both async and sync exceptions, and uninterruptibleMask will fix it only with respect to async exceptions.
The second version is (I hope) exception-safe -- it handle both async and sync exceptions. That is important point -- if you need uninterruptibleMask, then probably you have issue with sync exceptions too. Lets fix the original issue and make code exception safe instead of hiding it behind uninterruptibleMask.
Your second version is not exception-safe: async exceptions would just cease the first close, leak the handle and continue to the second close to potentially block again and either leak or close the second handle. This is not reasonable behavior for cleanup. If you wrap it all with uninterruptibleMask then it becomes as correct a cleanup as it can be.
You are wrong, hClose closes the handle in case of any exception, so there is no leak here. I already described that and pointed to source code. Probably my arguments are weak, but nobody even tried to argue the opposite. The relevant part:
People have been arguing the opposite. hClose is not guaranteed to close the handle in case an exception arises. Here's a demonstration program.
module Main where
import System.IO import Network.BSD import Network.Socket import Control.Concurrent import Control.Exception import Control.Applicative import Control.Monad
main = do sock <- socket AF_INET Stream 0 addr <- SockAddrInet 7777 <$> lookupHost "localhost" setSocketOption sock ReuseAddr 1 bindSocket sock addr listen sock 6 forkIO $ do tid <- myThreadId forkIO $ do sleep 10 print "killing" forkIO $ killThread tid >> print "killed it" return () bracket (opener sock) closer $ \h -> do forkIO $ listener h sleep 2 print "sleeping" sleep 120
listener h = forever $ do inp <- hGetLine h print inp
opener sock = do (s',addr) <- accept sock print $ "Got connection from: " ++ show addr socketToHandle s' ReadWriteMode
closer h = (hClose h `finally` print "closed")
sleep :: Double -> IO () sleep = threadDelay . round . (* 1e6)
lookupHost n = head . hostAddresses <$> getHostByName n
I compiled this with ghc-7.8.3 -O -threaded and ran it, then connected to
localhost:7777 via nc, waited until "closed" was printed, then sent some
data. This was the result:
jwlato@burial:~/explorations$ ./HClose
"sleeping"
"Got connection from: 127.0.0.1:45949"
"killing"
"killed it"
"closed"
"foo"
"bar"
"baz"
HClose:
There are two sources of possible interruptions in hClose: a) takeMVar b) flushing internal buffer
a) is not an issue in practice -- it will not be interrupted unless someone already uses the Handle (if it is the case, then you
has bigger issue -- you may use already closed handle.) But it
It is already implemented in such the way. Let me explain. probably probably
should be more careful and use uninterruptibleMask here... I don't have strong opinion.
b) is handled correctly, see
https://github.com/ghc/ghc/blob/805ee118b823f271dfd8036d35b15e b3454a95ad/libraries/base/GHC/IO/Handle/Internals.hs#L734
Basically it catches all exceptions (including async,) closes the handle and rethrows the exception.
"closes the handle" here means that "close" method of underlying IODevice is called. And now it is IODevice's author responsibility to handle exceptions correctly.
except that isn't guaranteed, as my program demonstrates.
Sync exceptions when closing your DB handles leave it in an undefined
state
(or at least, that's the underlying behavior of POSIX close). At that point, the handles cannot be re-closed (since they may have been reused in a different context).
So sync exceptions in hClose mean the program is incorrect, and the only recourse is to prevent the sync exceptions in the first place. Fortunately, these FDs are likely guaranteed to be valid so sync exceptions are virtually ruled out.
This is a general pattern with cleanups: a cleanup already has the allocated resource at hand, which almost always rules out sync exceptions. Also, exceptions during an error-induced cleanup cause dangerous error-silencing anyway since we cannot handle an exception within an exception.
So you have to inspect all the code, directly or indirectly used by cleanup action, to ensure it doesn't throw sync exception (just to find that it is not the case -- a lot of cleanup actions can throw sync exceptions in some, probably rare, cases.) Someone argued, that was exactly the issue the proposal was trying to solve.
Sync exceptions have nothing to do with the proposal. The proposal itself certainly doesn't argue this.
In my opinion you're incorrectly equating sync and async exceptions. The former can only be avoided by satisfying preconditions which you must do
in
cleanups. The latter can only be avoided by uninterruptibleMask, which you must also do in cleanups. The combination of the two is the only way to make exception-safe cleanups that:
I'm not equating them, I'm arguing for exception safe code.
Don't lie yourself, hClose can throw sync exception and it *will* throw
it sooner or later. If you are not prepared for that, you'll get mysterious bug. But if you are prepared, then just don't need uninterruptibleMask in bracket.
Again, this has nothing to do with hClose throwing sync exceptions. It does have to do with handlers that perform blocking operations and don't use uninterruptibleMask.
A) Do not break invariants if async exception is sent during cleanup B) Do not cause an exception within an exception (e.g: during bracket, onException or finally) where at least one exception must be lost, which
is
yet another bug which was overlooked in this discussion
It is not overlooked (I even posted link to discussion of this issue in the my fist reply to the thread.) But it is simply not relevant.
If hClose throws a sync exception there's *nothing* that can be done to make the code not leak the resource.
However:
bracket openFile hClose -- is correct with uninterruptibleMask and incorrect with mask. The potential for a sync exception in hClose here is irrelevant to the correctness that can be attained.
So it *does* in fact make writing exception-safe code much much easier.
Could you please point me to line in source code where hClose can throw exception without calling IODevice.close? Where it can be interrupted by async exception? And if you find such places, then why should not it be fixed?
If you find that uninterruptibleMask makes your life easer, then go ahead and use it. Sometimes it is even necessary to make code exception safe. But it is bad idea to use it in bracket from base because it actually only hides bug, not fixes them. As a result more bugs will remain unnoticed and not fixed for longer period.
Thanks, Yuras
_______________________________________________ Libraries mailing list Libraries@haskell.org http://www.haskell.org/mailman/listinfo/libraries