diff options
| -rw-r--r-- | Logs/Transfer.hs | 5 | ||||
| -rw-r--r-- | Utility/LockFile/Posix.hs | 13 | ||||
| -rw-r--r-- | Utility/LockPool/Posix.hs | 10 | ||||
| -rw-r--r-- | Utility/LockPool/STM.hs | 4 |
4 files changed, 23 insertions, 9 deletions
diff --git a/Logs/Transfer.hs b/Logs/Transfer.hs index ef1db879c..471b886b3 100644 --- a/Logs/Transfer.hs +++ b/Logs/Transfer.hs @@ -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 diff --git a/Utility/LockFile/Posix.hs b/Utility/LockFile/Posix.hs index 65ba328df..18d9e4fc1 100644 --- a/Utility/LockFile/Posix.hs +++ b/Utility/LockFile/Posix.hs @@ -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 diff --git a/Utility/LockPool/Posix.hs b/Utility/LockPool/Posix.hs index e05ab9754..506d7b560 100644 --- a/Utility/LockPool/Posix.hs +++ b/Utility/LockPool/Posix.hs @@ -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 diff --git a/Utility/LockPool/STM.hs b/Utility/LockPool/STM.hs index 2ab969b20..7b0d138b9 100644 --- a/Utility/LockPool/STM.hs +++ b/Utility/LockPool/STM.hs @@ -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 |