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:
parent
e386e26ef2
commit
1994771215
4 changed files with 68 additions and 39 deletions
|
@ -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
|
||||
|
|
11
Annex/Ssh.hs
11
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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue