mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

open lock file ReadOnly when taking shared lock

Browse source 
It's only necessary to open a file for write when taking an exclusive lock.
This commit is contained in:
Joey Hess 2015-10-08 13:31:55 -04:00
parent cb4c950afd
commit 9461019e9a
Failed to extract signature
1 changed files with 10 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

16
Utility/LockFile/Posix.hs
View file

@ -39,7 +39,7 @@ lockExclusive = lock WriteLock
-- Tries to take an exclusive lock, but does not block. -- Tries to take an exclusive lock, but does not block.
tryLockExclusive :: Maybe FileMode -> LockFile -> IO (Maybe LockHandle) tryLockExclusive :: Maybe FileMode -> LockFile -> IO (Maybe LockHandle)
tryLockExclusive mode lockfile = do tryLockExclusive mode lockfile = do
l <- openLockFile mode lockfile l <- openLockFile WriteLock mode lockfile
v <- tryIO $ setLock l (WriteLock, AbsoluteSeek, 0, 0) v <- tryIO $ setLock l (WriteLock, AbsoluteSeek, 0, 0)
case v of case v of
Left _ -> do Left _ -> do
@ -51,16 +51,20 @@ tryLockExclusive mode lockfile = do
-- If it's Nothing then this only succeeds when the lock file already exists. -- If it's Nothing then this only succeeds when the lock file already exists.
lock :: LockRequest -> Maybe FileMode -> LockFile -> IO LockHandle lock :: LockRequest -> Maybe FileMode -> LockFile -> IO LockHandle
lock lockreq mode lockfile = do lock lockreq mode lockfile = do
l <- openLockFile mode lockfile l <- openLockFile lockreq mode lockfile
waitToSetLock l (lockreq, AbsoluteSeek, 0, 0) waitToSetLock l (lockreq, AbsoluteSeek, 0, 0)
return (LockHandle l) return (LockHandle l)
-- Close on exec flag is set so child processes do not inherit the lock. -- Close on exec flag is set so child processes do not inherit the lock.
openLockFile :: Maybe FileMode -> LockFile -> IO Fd openLockFile :: LockRequest -> Maybe FileMode -> LockFile -> IO Fd
openLockFile filemode lockfile = do openLockFile lockreq filemode lockfile = do
l <- openFd lockfile ReadWrite filemode defaultFileFlags l <- openFd lockfile openfor filemode defaultFileFlags
setFdOption l CloseOnExec True setFdOption l CloseOnExec True
return l return l
where
openfor = case lockreq of
ReadLock -> ReadOnly
_ -> ReadWrite
-- Returns Nothing when the file doesn't exist, for cases where -- Returns Nothing when the file doesn't exist, for cases where
-- that is different from it not being locked. -- that is different from it not being locked.
@ -81,7 +85,7 @@ getLockStatus lockfile = do
getLockStatus' :: LockFile -> IO (Maybe (Maybe ProcessID)) getLockStatus' :: LockFile -> IO (Maybe (Maybe ProcessID))
getLockStatus' lockfile = go =<< catchMaybeIO open getLockStatus' lockfile = go =<< catchMaybeIO open
where where
open = openFd lockfile ReadOnly Nothing defaultFileFlags open = openLockFile ReadLock Nothing lockfile
go Nothing = return Nothing go Nothing = return Nothing
go (Just h) = do go (Just h) = do
v <- getLock h (ReadLock, AbsoluteSeek, 0, 0) v <- getLock h (ReadLock, AbsoluteSeek, 0, 0)