summaryrefslogtreecommitdiff
path: root/Utility/LockFile/Posix.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Utility/LockFile/Posix.hs')
-rw-r--r--Utility/LockFile/Posix.hs54
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