diff options
Diffstat (limited to 'Utility')
-rw-r--r-- | Utility/LockFile/Posix.hs | 54 |
1 files changed, 44 insertions, 10 deletions
diff --git a/Utility/LockFile/Posix.hs b/Utility/LockFile/Posix.hs index b49c5f173..1e43a2832 100644 --- a/Utility/LockFile/Posix.hs +++ b/Utility/LockFile/Posix.hs @@ -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 |