From e2693da16db892d002b2993443bcbe38b6c6efa0 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 8 Oct 2015 13:31:55 -0400 Subject: open lock file ReadOnly when taking shared lock It's only necessary to open a file for write when taking an exclusive lock. --- Utility/LockFile/Posix.hs | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) (limited to 'Utility/LockFile/Posix.hs') diff --git a/Utility/LockFile/Posix.hs b/Utility/LockFile/Posix.hs index 18d9e4fc1..8f06ae69e 100644 --- a/Utility/LockFile/Posix.hs +++ b/Utility/LockFile/Posix.hs @@ -39,7 +39,7 @@ lockExclusive = lock WriteLock -- Tries to take an exclusive lock, but does not block. tryLockExclusive :: Maybe FileMode -> LockFile -> IO (Maybe LockHandle) tryLockExclusive mode lockfile = do - l <- openLockFile mode lockfile + l <- openLockFile WriteLock mode lockfile v <- tryIO $ setLock l (WriteLock, AbsoluteSeek, 0, 0) case v of Left _ -> do @@ -51,16 +51,20 @@ tryLockExclusive mode lockfile = do -- If it's Nothing then this only succeeds when the lock file already exists. lock :: LockRequest -> Maybe FileMode -> LockFile -> IO LockHandle lock lockreq mode lockfile = do - l <- openLockFile mode lockfile + l <- openLockFile lockreq mode lockfile waitToSetLock l (lockreq, AbsoluteSeek, 0, 0) return (LockHandle l) -- Close on exec flag is set so child processes do not inherit the lock. -openLockFile :: Maybe FileMode -> LockFile -> IO Fd -openLockFile filemode lockfile = do - l <- openFd lockfile ReadWrite filemode defaultFileFlags +openLockFile :: LockRequest -> Maybe FileMode -> LockFile -> IO Fd +openLockFile lockreq filemode lockfile = do + l <- openFd lockfile openfor filemode defaultFileFlags setFdOption l CloseOnExec True return l + where + openfor = case lockreq of + ReadLock -> ReadOnly + _ -> ReadWrite -- Returns Nothing when the file doesn't exist, for cases where -- that is different from it not being locked. @@ -81,7 +85,7 @@ getLockStatus lockfile = do getLockStatus' :: LockFile -> IO (Maybe (Maybe ProcessID)) getLockStatus' lockfile = go =<< catchMaybeIO open where - open = openFd lockfile ReadOnly Nothing defaultFileFlags + open = openLockFile ReadLock Nothing lockfile go Nothing = return Nothing go (Just h) = do v <- getLock h (ReadLock, AbsoluteSeek, 0, 0) -- cgit v1.2.3 From dc7576766528bf5b9951b3f355f49a9f8fc1f183 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Thu, 8 Oct 2015 13:40:23 -0400 Subject: add tryLockShared --- Utility/LockFile/Posix.hs | 25 +++++++++++++++++-------- Utility/LockPool/Posix.hs | 9 +++++++++ 2 files changed, 26 insertions(+), 8 deletions(-) (limited to 'Utility/LockFile/Posix.hs') diff --git a/Utility/LockFile/Posix.hs b/Utility/LockFile/Posix.hs index 8f06ae69e..cf88fa87d 100644 --- a/Utility/LockFile/Posix.hs +++ b/Utility/LockFile/Posix.hs @@ -9,6 +9,7 @@ module Utility.LockFile.Posix ( LockHandle, lockShared, lockExclusive, + tryLockShared, tryLockExclusive, checkLocked, getLockStatus, @@ -36,16 +37,13 @@ lockShared = lock ReadLock lockExclusive :: Maybe FileMode -> LockFile -> IO LockHandle lockExclusive = lock WriteLock +-- Tries to take a shared lock, but does not block. +tryLockShared :: Maybe FileMode -> LockFile -> IO (Maybe LockHandle) +tryLockShared = tryLock ReadLock + -- Tries to take an exclusive lock, but does not block. tryLockExclusive :: Maybe FileMode -> LockFile -> IO (Maybe LockHandle) -tryLockExclusive mode lockfile = do - l <- openLockFile WriteLock mode lockfile - v <- tryIO $ setLock l (WriteLock, AbsoluteSeek, 0, 0) - case v of - Left _ -> do - closeFd l - return Nothing - Right _ -> return $ Just $ LockHandle l +tryLockExclusive = tryLock WriteLock -- Setting the FileMode allows creation of a new lock file. -- If it's Nothing then this only succeeds when the lock file already exists. @@ -55,6 +53,17 @@ lock lockreq mode lockfile = do waitToSetLock l (lockreq, AbsoluteSeek, 0, 0) return (LockHandle l) +-- Tries to take an lock, but does not block. +tryLock :: LockRequest -> Maybe FileMode -> LockFile -> IO (Maybe LockHandle) +tryLock lockreq mode lockfile = do + l <- openLockFile lockreq mode lockfile + v <- tryIO $ setLock l (lockreq, AbsoluteSeek, 0, 0) + case v of + Left _ -> do + closeFd l + return Nothing + Right _ -> return $ Just $ LockHandle l + -- Close on exec flag is set so child processes do not inherit the lock. openLockFile :: LockRequest -> Maybe FileMode -> LockFile -> IO Fd openLockFile lockreq filemode lockfile = do diff --git a/Utility/LockPool/Posix.hs b/Utility/LockPool/Posix.hs index 506d7b560..82e0c8e5e 100644 --- a/Utility/LockPool/Posix.hs +++ b/Utility/LockPool/Posix.hs @@ -9,6 +9,7 @@ module Utility.LockPool.Posix ( LockHandle, lockShared, lockExclusive, + tryLockShared, tryLockExclusive, checkLocked, getLockStatus, @@ -35,11 +36,19 @@ lockShared mode file = makeLockHandle (P.waitTakeLock P.lockPool file LockShared) (F.lockShared mode file) +-- Takes an exclusive lock, blocking until the lock is available. lockExclusive :: Maybe FileMode -> LockFile -> IO LockHandle lockExclusive mode file = makeLockHandle (P.waitTakeLock P.lockPool file LockExclusive) (F.lockExclusive mode file) +-- Tries to take a shared lock, but does not block. +tryLockShared :: Maybe FileMode -> LockFile -> IO (Maybe LockHandle) +tryLockShared mode file = tryMakeLockHandle + (P.tryTakeLock P.lockPool file LockShared) + (F.tryLockShared mode file) + +-- Tries to take an exclusive lock, but does not block. tryLockExclusive :: Maybe FileMode -> LockFile -> IO (Maybe LockHandle) tryLockExclusive mode file = tryMakeLockHandle (P.tryTakeLock P.lockPool file LockExclusive) -- cgit v1.2.3