diff options
| -rw-r--r-- | Logs/Transfer.hs | 17 | ||||
| -rw-r--r-- | Utility/LockFile/Posix.hs | 16 |
2 files changed, 18 insertions, 15 deletions
diff --git a/Logs/Transfer.hs b/Logs/Transfer.hs index 7928972b3..16c3ebb68 100644 --- a/Logs/Transfer.hs +++ b/Logs/Transfer.hs @@ -129,17 +129,12 @@ checkTransfer :: Transfer -> Annex (Maybe TransferInfo) checkTransfer t = do tfile <- fromRepo $ transferFile t #ifndef mingw32_HOST_OS - mfd <- liftIO $ openExistingLockFile (transferLockFile tfile) - case mfd of - Nothing -> return Nothing -- failed to open file; not running - Just fd -> do - locked <- liftIO $ - getLock fd (WriteLock, AbsoluteSeek, 0, 0) - liftIO $ closeFd fd - case locked of - Nothing -> return Nothing - Just (pid, _) -> liftIO $ catchDefaultIO Nothing $ - readTransferInfoFile (Just pid) tfile + liftIO $ do + v <- getLockStatus (transferLockFile tfile) + case v of + Just (pid, _) -> catchDefaultIO Nothing $ + readTransferInfoFile (Just pid) tfile + Nothing -> return Nothing #else v <- liftIO $ lockShared $ transferLockFile tfile liftIO $ case v of diff --git a/Utility/LockFile/Posix.hs b/Utility/LockFile/Posix.hs index 1e43a2832..6e4444fcf 100644 --- a/Utility/LockFile/Posix.hs +++ b/Utility/LockFile/Posix.hs @@ -14,6 +14,7 @@ module Utility.LockFile.Posix ( openExistingLockFile, isLocked, checkLocked, + getLockStatus, dropLock, ) where @@ -23,7 +24,6 @@ import Utility.Applicative import System.IO import System.Posix import Data.Maybe -import Control.Applicative type LockFile = FilePath @@ -77,15 +77,23 @@ openLockFile filemode lockfile = do isLocked :: LockFile -> IO Bool isLocked = fromMaybe False <$$> checkLocked +-- 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 lockfile = go =<< catchMaybeIO open +checkLocked = maybe Nothing (Just . isJust) <$$> getLockStatus' + +getLockStatus :: LockFile -> IO (Maybe (ProcessID, FileLock)) +getLockStatus = fromMaybe Nothing <$$> getLockStatus' + +getLockStatus' :: LockFile -> IO (Maybe (Maybe (ProcessID, FileLock))) +getLockStatus' lockfile = go =<< catchMaybeIO open where open = openFd lockfile ReadOnly Nothing defaultFileFlags go Nothing = return Nothing go (Just h) = do - ret <- isJust <$> getLock h (ReadLock, AbsoluteSeek, 0, 0) + ret <- getLock h (ReadLock, AbsoluteSeek, 0, 0) closeFd h - return $ Just ret + return (Just ret) dropLock :: LockHandle -> IO () dropLock (LockHandle fd) = closeFd fd |