From b85c3e0455125a192000fd828348e2b410b2569c Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Wed, 20 Aug 2014 19:09:54 -0400 Subject: final scary locking refactoring (for now) Note that while before checkTransfer this called getLock with WriteLock, getLockStatus's use of ReadLock will also notice any exclusive locks. Since transfer info files are only locked exclusively, never shared, there is no behavior change. Also, fixes checkLocked to actually return Just False when the file exists, but is not locked. --- Utility/LockFile/Posix.hs | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) (limited to 'Utility') 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 -- cgit v1.2.3