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