fix crash in stale transfer lockfile cleanup code
Need to differentiate between the lockfile not being locked, and it not existing.
This commit is contained in:
parent
26bb2c40f8
commit
9de5cd2966
4 changed files with 23 additions and 9 deletions
|
@ -140,9 +140,10 @@ checkTransfer t = do
|
|||
let lck = transferLockFile tfile
|
||||
v <- getLockStatus lck
|
||||
case v of
|
||||
Just pid -> catchDefaultIO Nothing $
|
||||
StatusLockedBy pid -> catchDefaultIO Nothing $
|
||||
readTransferInfoFile (Just pid) tfile
|
||||
Nothing -> do
|
||||
StatusNoLockFile -> return Nothing
|
||||
StatusUnLocked -> do
|
||||
-- Take a non-blocking lock while deleting
|
||||
-- the stale lock file.
|
||||
r <- tryLockExclusive Nothing lck
|
||||
|
|
|
@ -12,6 +12,7 @@ module Utility.LockFile.Posix (
|
|||
tryLockExclusive,
|
||||
checkLocked,
|
||||
getLockStatus,
|
||||
LockStatus(..),
|
||||
dropLock,
|
||||
checkSaneLock,
|
||||
) where
|
||||
|
@ -66,8 +67,16 @@ openLockFile filemode lockfile = do
|
|||
checkLocked :: LockFile -> IO (Maybe Bool)
|
||||
checkLocked = maybe Nothing (Just . isJust) <$$> getLockStatus'
|
||||
|
||||
getLockStatus :: LockFile -> IO (Maybe ProcessID)
|
||||
getLockStatus = fromMaybe Nothing <$$> getLockStatus'
|
||||
data LockStatus = StatusUnLocked | StatusLockedBy ProcessID | StatusNoLockFile
|
||||
deriving (Eq)
|
||||
|
||||
getLockStatus :: LockFile -> IO LockStatus
|
||||
getLockStatus lockfile = do
|
||||
v <- getLockStatus' lockfile
|
||||
return $ case v of
|
||||
Nothing -> StatusNoLockFile
|
||||
Just Nothing -> StatusUnLocked
|
||||
Just (Just pid) -> StatusLockedBy pid
|
||||
|
||||
getLockStatus' :: LockFile -> IO (Maybe (Maybe ProcessID))
|
||||
getLockStatus' lockfile = go =<< catchMaybeIO open
|
||||
|
|
|
@ -12,11 +12,13 @@ module Utility.LockPool.Posix (
|
|||
tryLockExclusive,
|
||||
checkLocked,
|
||||
getLockStatus,
|
||||
LockStatus(..),
|
||||
dropLock,
|
||||
checkSaneLock,
|
||||
) where
|
||||
|
||||
import qualified Utility.LockFile.Posix as F
|
||||
import Utility.LockFile.Posix (LockStatus(..))
|
||||
import qualified Utility.LockPool.STM as P
|
||||
import Utility.LockPool.STM (LockFile, LockMode(..))
|
||||
import Utility.LockPool.LockHandle
|
||||
|
@ -46,11 +48,13 @@ tryLockExclusive mode file = tryMakeLockHandle
|
|||
-- Returns Nothing when the file doesn't exist, for cases where
|
||||
-- that is different from it not being locked.
|
||||
checkLocked :: LockFile -> IO (Maybe Bool)
|
||||
checkLocked file = P.getLockStatus P.lockPool file (pure True)
|
||||
checkLocked file = P.getLockStatus P.lockPool file
|
||||
(pure (Just True))
|
||||
(F.checkLocked file)
|
||||
|
||||
getLockStatus :: LockFile -> IO (Maybe ProcessID)
|
||||
getLockStatus file = P.getLockStatus P.lockPool file getProcessID
|
||||
getLockStatus :: LockFile -> IO LockStatus
|
||||
getLockStatus file = P.getLockStatus P.lockPool file
|
||||
(StatusLockedBy <$> getProcessID)
|
||||
(F.getLockStatus file)
|
||||
|
||||
checkSaneLock :: LockFile -> LockHandle -> IO Bool
|
||||
|
|
|
@ -81,7 +81,7 @@ tryTakeLock pool file mode =
|
|||
-- danger of conflicting with locks created at the same time this is
|
||||
-- running. With the lock pool empty, anything that attempts
|
||||
-- to take a lock will block, avoiding that race.
|
||||
getLockStatus :: LockPool -> LockFile -> IO v -> IO (Maybe v) -> IO (Maybe v)
|
||||
getLockStatus :: LockPool -> LockFile -> IO v -> IO v -> IO v
|
||||
getLockStatus pool file getdefault checker = do
|
||||
v <- atomically $ do
|
||||
m <- takeTMVar pool
|
||||
|
@ -94,7 +94,7 @@ getLockStatus pool file getdefault checker = do
|
|||
return Nothing
|
||||
else return $ Just $ atomically $ putTMVar pool m
|
||||
case v of
|
||||
Nothing -> Just <$> getdefault
|
||||
Nothing -> getdefault
|
||||
Just restore -> bracket_ (return ()) restore checker
|
||||
|
||||
-- Only runs action to close underlying lock file when this is the last
|
||||
|
|
Loading…
Reference in a new issue