From 94a3e606fb31150c969d63790ec1ef870f413cc1 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 18 May 2015 14:16:49 -0400 Subject: lock pools to work around non-concurrency/composition safety of POSIX fcntl --- Utility/LockFile/Posix.hs | 14 ++++---------- 1 file changed, 4 insertions(+), 10 deletions(-) (limited to 'Utility/LockFile/Posix.hs') diff --git a/Utility/LockFile/Posix.hs b/Utility/LockFile/Posix.hs index 9013bd32c..12275c48a 100644 --- a/Utility/LockFile/Posix.hs +++ b/Utility/LockFile/Posix.hs @@ -12,7 +12,6 @@ module Utility.LockFile.Posix ( tryLockExclusive, createLockFile, openExistingLockFile, - isLocked, checkLocked, getLockStatus, dropLock, @@ -73,28 +72,23 @@ openLockFile filemode lockfile = do setFdOption l CloseOnExec True return l --- Check if a file is locked, either exclusively, or with shared lock. --- When the file doesn't exist, it's considered not locked. -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 = maybe Nothing (Just . isJust) <$$> getLockStatus' -getLockStatus :: LockFile -> IO (Maybe (ProcessID, FileLock)) +getLockStatus :: LockFile -> IO (Maybe ProcessID) getLockStatus = fromMaybe Nothing <$$> getLockStatus' -getLockStatus' :: LockFile -> IO (Maybe (Maybe (ProcessID, FileLock))) +getLockStatus' :: LockFile -> IO (Maybe (Maybe ProcessID)) getLockStatus' lockfile = go =<< catchMaybeIO open where open = openFd lockfile ReadOnly Nothing defaultFileFlags go Nothing = return Nothing go (Just h) = do - ret <- getLock h (ReadLock, AbsoluteSeek, 0, 0) + v <- getLock h (ReadLock, AbsoluteSeek, 0, 0) closeFd h - return (Just ret) + return (Just (fmap fst v)) dropLock :: LockHandle -> IO () dropLock (LockHandle fd) = closeFd fd -- cgit v1.2.3