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:
Joey Hess 2015-05-19 23:35:24 -04:00
parent 26bb2c40f8
commit 9de5cd2966
4 changed files with 23 additions and 9 deletions

View file

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

View file

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

View file

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

View file

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