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:
Joey Hess 2020-06-09 13:48:48 -04:00
parent 7013798df5
commit 24ff5e2b29
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
4 changed files with 7 additions and 7 deletions

View file

@ -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

View file

@ -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

View file

@ -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

View file

@ -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