more lock file refactoring

Also fixes a test suite failures introduced in recent commits, where
inAnnexSafe failed in indirect mode, since it tried to open the lock file
ReadWrite. This is why the new checkLocked opens it ReadOnly.

This commit was sponsored by Chad Horohoe.
This commit is contained in:
Joey Hess 2014-08-20 18:56:25 -04:00
parent e386e26ef2
commit 1994771215
4 changed files with 68 additions and 39 deletions

View file

@ -9,15 +9,21 @@ module Utility.LockFile.Posix (
LockHandle,
lockShared,
lockExclusive,
dropLock,
tryLockExclusive,
createLockFile,
openExistingLockFile,
isLocked,
checkLocked,
dropLock,
) where
import Utility.Exception
import Utility.Applicative
import System.IO
import System.Posix
import Data.Maybe
import Control.Applicative
type LockFile = FilePath
@ -31,27 +37,55 @@ lockShared = lock ReadLock
lockExclusive :: Maybe FileMode -> LockFile -> IO LockHandle
lockExclusive = lock WriteLock
-- The FileMode is used when creating a new lock file.
-- 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
v <- tryIO $ setLock l (WriteLock, AbsoluteSeek, 0, 0)
case v of
Left _ -> do
closeFd l
return Nothing
Right _ -> return $ Just $ LockHandle l
-- Setting the FileMode allows creation of a new lock file.
-- 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 <- createLockFile mode lockfile
l <- openLockFile mode lockfile
waitToSetLock l (lockreq, AbsoluteSeek, 0, 0)
return (LockHandle l)
-- Create and opens lock file; does not lock it.
createLockFile :: Maybe FileMode -> LockFile -> IO Fd
createLockFile = openLockFile ReadWrite
createLockFile :: FileMode -> LockFile -> IO Fd
createLockFile filemode = openLockFile (Just filemode)
-- Opens an existing lock file; does not lock it or create it.
-- Opens an existing lock file; does not lock it, and if it does not exist,
-- returns Nothing.
openExistingLockFile :: LockFile -> IO (Maybe Fd)
openExistingLockFile = catchMaybeIO . openLockFile ReadOnly Nothing
openExistingLockFile = catchMaybeIO . openLockFile Nothing
-- Close on exec flag is set so child processes do not inherit the lock.
openLockFile :: OpenMode -> Maybe FileMode -> LockFile -> IO Fd
openLockFile openmode filemode lockfile = do
l <- openFd lockfile openmode filemode defaultFileFlags
openLockFile :: Maybe FileMode -> LockFile -> IO Fd
openLockFile filemode lockfile = do
l <- openFd lockfile ReadWrite filemode defaultFileFlags
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
checkLocked :: LockFile -> IO (Maybe Bool)
checkLocked 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)
closeFd h
return $ Just ret
dropLock :: LockHandle -> IO ()
dropLock (LockHandle fd) = closeFd fd