use uninterruptibleMask
Some recent changes to use mask missed that async exceptions can still be thrown inside it. The goal is to make sure a block of cleanup code runs entirely, w/o being interrupted by an async exception, so use uninterruptibleMask. Also, converted a few to bracket, which is nicer.
This commit is contained in:
parent
7013798df5
commit
24ff5e2b29
4 changed files with 7 additions and 7 deletions
|
@ -230,9 +230,10 @@ probeLockSupport = withEventuallyCleanedOtherTmp $ \tmp -> do
|
||||||
where
|
where
|
||||||
go f mode = do
|
go f mode = do
|
||||||
nukeFile f
|
nukeFile f
|
||||||
let locktest = mask $ const $
|
let locktest = bracket
|
||||||
Posix.lockExclusive (Just mode) f
|
(Posix.lockExclusive (Just mode) f)
|
||||||
>>= Posix.dropLock
|
Posix.dropLock
|
||||||
|
(const noop)
|
||||||
ok <- isRight <$> tryNonAsync locktest
|
ok <- isRight <$> tryNonAsync locktest
|
||||||
nukeFile f
|
nukeFile f
|
||||||
return ok
|
return ok
|
||||||
|
|
|
@ -94,5 +94,4 @@ tryPidLock m f posixlock = debugLocks $ liftIO . go =<< pidLockFile
|
||||||
-- avoid complicating any code that might expect to be able to see that
|
-- avoid complicating any code that might expect to be able to see that
|
||||||
-- lock file. But, it's not locked.
|
-- lock file. But, it's not locked.
|
||||||
dummyPosixLock :: Maybe FileMode -> LockFile -> IO ()
|
dummyPosixLock :: Maybe FileMode -> LockFile -> IO ()
|
||||||
dummyPosixLock m f = mask $ const $
|
dummyPosixLock m f = bracket (openLockFile ReadLock m f) closeFd (const noop)
|
||||||
closeFd =<< openLockFile ReadLock m f
|
|
||||||
|
|
|
@ -200,7 +200,7 @@ closeP2PSshConnection :: P2PSshConnection -> IO (P2PSshConnection, Maybe ExitCod
|
||||||
closeP2PSshConnection P2P.ClosedConnection = return (P2P.ClosedConnection, Nothing)
|
closeP2PSshConnection P2P.ClosedConnection = return (P2P.ClosedConnection, Nothing)
|
||||||
closeP2PSshConnection (P2P.OpenConnection (_st, conn, pid, stderrhandlerst)) =
|
closeP2PSshConnection (P2P.OpenConnection (_st, conn, pid, stderrhandlerst)) =
|
||||||
-- mask async exceptions, avoid cleanup being interrupted
|
-- mask async exceptions, avoid cleanup being interrupted
|
||||||
mask $ const $ do
|
uninterruptibleMask_ $ do
|
||||||
P2P.closeConnection conn
|
P2P.closeConnection conn
|
||||||
atomically $ writeTVar stderrhandlerst EndStderrHandler
|
atomically $ writeTVar stderrhandlerst EndStderrHandler
|
||||||
exitcode <- waitForProcess pid
|
exitcode <- waitForProcess pid
|
||||||
|
|
|
@ -58,7 +58,7 @@ lock lockreq mode lockfile = do
|
||||||
|
|
||||||
-- Tries to take an lock, but does not block.
|
-- Tries to take an lock, but does not block.
|
||||||
tryLock :: LockRequest -> Maybe FileMode -> LockFile -> IO (Maybe LockHandle)
|
tryLock :: LockRequest -> Maybe FileMode -> LockFile -> IO (Maybe LockHandle)
|
||||||
tryLock lockreq mode lockfile = mask $ const $ do
|
tryLock lockreq mode lockfile = uninterruptibleMask_ $ do
|
||||||
l <- openLockFile lockreq mode lockfile
|
l <- openLockFile lockreq mode lockfile
|
||||||
v <- tryIO $ setLock l (lockreq, AbsoluteSeek, 0, 0)
|
v <- tryIO $ setLock l (lockreq, AbsoluteSeek, 0, 0)
|
||||||
case v of
|
case v of
|
||||||
|
|
Loading…
Add table
Add a link
Reference in a new issue