summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Annex/Content.hs32
-rw-r--r--Annex/Ssh.hs11
-rw-r--r--Remote/Helper/Hooks.hs10
-rw-r--r--Utility/LockFile/Posix.hs54
4 files changed, 68 insertions, 39 deletions
diff --git a/Annex/Content.hs b/Annex/Content.hs
index b3c62ee0a..90ab7db58 100644
--- a/Annex/Content.hs
+++ b/Annex/Content.hs
@@ -101,23 +101,21 @@ inAnnexSafe key = inAnnex' (fromMaybe False) (Just False) go key
=<< contentLockFile key
#ifndef mingw32_HOST_OS
- checkindirect f = liftIO $ openExistingLockFile f >>= check is_missing
+ checkindirect contentfile = liftIO $ checkOr is_missing contentfile
{- In direct mode, the content file must exist, but
- - the lock file often generally won't exist unless a removal is in
- - process. This does not create the lock file, it only checks for
- - it. -}
+ - the lock file generally won't exist unless a removal is in
+ - process. -}
checkdirect contentfile lockfile = liftIO $
ifM (doesFileExist contentfile)
- ( openExistingLockFile lockfile >>= check is_unlocked
+ ( checkOr is_unlocked lockfile
, return is_missing
)
- check _ (Just h) = do
- v <- getLock h (ReadLock, AbsoluteSeek, 0, 0)
- closeFd h
+ checkOr def lockfile = do
+ v <- checkLocked lockfile
return $ case v of
- Just _ -> is_locked
- Nothing -> is_unlocked
- check def Nothing = return def
+ Nothing -> def
+ Just True -> is_locked
+ Just False -> is_unlocked
#else
checkindirect f = liftIO $ ifM (doesFileExist f)
( do
@@ -161,7 +159,7 @@ lockContent key a = do
contentfile <- calcRepo $ gitAnnexLocation key
lockfile <- contentLockFile key
maybe noop setuplockfile lockfile
- bracket (liftIO $ lock contentfile lockfile) (unlock lockfile) (const a)
+ bracket (lock contentfile lockfile) (unlock lockfile) (const a)
where
alreadylocked = error "content is locked"
setuplockfile lockfile = modifyContent lockfile $
@@ -171,8 +169,11 @@ lockContent key a = do
void $ liftIO $ tryIO $
nukeFile lockfile
#ifndef mingw32_HOST_OS
- lock contentfile Nothing = opencontentforlock contentfile >>= dolock
- lock _ (Just lockfile) = createLockFile Nothing lockfile >>= dolock . Just
+ lock contentfile Nothing = liftIO $
+ opencontentforlock contentfile >>= dolock
+ lock _ (Just lockfile) = do
+ mode <- annexFileMode
+ liftIO $ createLockFile mode lockfile >>= dolock . Just
{- Since content files are stored with the write bit disabled, have
- to fiddle with permissions to open for an exclusive lock. -}
opencontentforlock f = catchDefaultIO Nothing $
@@ -189,7 +190,8 @@ lockContent key a = do
maybe noop cleanuplockfile mlockfile
liftIO $ maybe noop closeFd mfd
#else
- lock _ (Just lockfile) = maybe alreadylocked (return . Just) =<< lockExclusive lockfile
+ lock _ (Just lockfile) = liftIO $
+ maybe alreadylocked (return . Just) =<< lockExclusive lockfile
lock _ Nothing = return Nothing
unlock mlockfile mlockhandle = do
liftIO $ maybe noop dropLock mlockhandle
diff --git a/Annex/Ssh.hs b/Annex/Ssh.hs
index 2b1b809ff..ad636b4aa 100644
--- a/Annex/Ssh.hs
+++ b/Annex/Ssh.hs
@@ -152,13 +152,12 @@ sshCleanup = mapM_ cleanup =<< enumSocketFiles
let lockfile = socket2lock socketfile
unlockFile lockfile
mode <- annexFileMode
- fd <- liftIO $ noUmask mode $ createLockFile (Just mode) lockfile
- v <- liftIO $ tryIO $
- setLock fd (WriteLock, AbsoluteSeek, 0, 0)
+ v <- liftIO $ noUmask mode $ tryLockExclusive (Just mode) lockfile
case v of
- Left _ -> noop
- Right _ -> forceStopSsh socketfile
- liftIO $ closeFd fd
+ Nothing -> noop
+ Just lck -> do
+ forceStopSsh socketfile
+ liftIO $ dropLock lck
#else
forceStopSsh socketfile
#endif
diff --git a/Remote/Helper/Hooks.hs b/Remote/Helper/Hooks.hs
index 96f73cce3..529c35d3f 100644
--- a/Remote/Helper/Hooks.hs
+++ b/Remote/Helper/Hooks.hs
@@ -83,18 +83,12 @@ runHooks r starthook stophook a = do
unlockFile lck
#ifndef mingw32_HOST_OS
mode <- annexFileMode
- fd <- liftIO $ noUmask mode $ createLockFile (Just mode) lck
- v <- liftIO $ tryIO $
- setLock fd (WriteLock, AbsoluteSeek, 0, 0)
- case v of
- Left _ -> noop
- Right _ -> run stophook
- liftIO $ closeFd fd
+ v <- liftIO $ noUmask mode $ tryLockExclusive (Just mode) lck
#else
v <- liftIO $ lockExclusive lck
+#endif
case v of
Nothing -> noop
Just lockhandle -> do
run stophook
liftIO $ dropLock lockhandle
-#endif
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