mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

make LockPool's LockHandle be able to support multiple different types of file locks

Browse source
This commit is contained in:
Joey Hess 2015-11-12 16:28:11 -04:00
parent 710d1eeeac
commit e7552e4cee
Failed to extract signature
3 changed files with 37 additions and 21 deletions
Download patch file Download diff file Expand all files Collapse all files

33
Utility/LockPool/LockHandle.hs
View file

@ -10,33 +10,38 @@
module Utility.LockPool.LockHandle where
import qualified Utility.LockPool.STM as P
#ifndef mingw32_HOST_OS
import qualified Utility.LockFile.Posix as F
#else
import qualified Utility.LockFile.Windows as F
#endif
import Control.Concurrent.STM
import Control.Exception
data LockHandle = LockHandle P.LockHandle F.LockHandle
data LockHandle = LockHandle
{ poolHandle :: P.LockHandle
, fileLockOps :: FileLockOps
}
data FileLockOps = FileLockOps
{ fDropLock :: IO ()
#ifndef mingw32_HOST_OS
, fCheckSaneLock :: FilePath -> IO Bool
#endif
}
dropLock :: LockHandle -> IO ()
dropLock (LockHandle ph fh) = P.releaseLock ph (F.dropLock fh)
dropLock h = P.releaseLock (poolHandle h) (fDropLock (fileLockOps h))
-- Take a lock, by first updating the lock pool, and then taking the file
-- lock. If taking the file lock fails for any reason, take care to
-- release the lock in the lock pool.
makeLockHandle :: STM P.LockHandle -> IO F.LockHandle -> IO LockHandle
makeLockHandle :: STM P.LockHandle -> IO FileLockOps -> IO LockHandle
makeLockHandle pa fa = bracketOnError setup cleanup go
where
setup = atomically pa
cleanup ph = P.releaseLock ph (return ())
go ph = do
fh <- fa
return $ LockHandle ph fh
fo <- fa
return $ LockHandle ph fo
tryMakeLockHandle :: STM (Maybe P.LockHandle) -> IO (Maybe F.LockHandle) -> IO (Maybe LockHandle)
tryMakeLockHandle :: STM (Maybe P.LockHandle) -> IO (Maybe FileLockOps) -> IO (Maybe LockHandle)
tryMakeLockHandle pa fa = bracketOnError setup cleanup go
where
setup = atomically pa
@ -44,9 +49,9 @@ tryMakeLockHandle pa fa = bracketOnError setup cleanup go
cleanup (Just ph) = P.releaseLock ph (return ())
go Nothing = return Nothing
go (Just ph) = do
mfh <- fa
case mfh of
mfo <- fa
case mfo of
Nothing -> do
cleanup (Just ph)
return Nothing
Just fh -> return $ Just $ LockHandle ph fh
Just fo -> return $ Just $ LockHandle ph fo