86 lines
2.5 KiB
Haskell
86 lines
2.5 KiB
Haskell
{- Wraps Utility.LockPool, making pid locks be used when git-annex is so
|
|
- configured.
|
|
-
|
|
- Copyright 2015 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
module Annex.LockPool.PosixOrPid (
|
|
LockFile,
|
|
LockHandle,
|
|
lockShared,
|
|
lockExclusive,
|
|
tryLockShared,
|
|
tryLockExclusive,
|
|
dropLock,
|
|
checkLocked,
|
|
LockStatus(..),
|
|
getLockStatus,
|
|
checkSaneLock,
|
|
) where
|
|
|
|
import Common.Annex
|
|
import qualified Annex
|
|
import qualified Utility.LockPool.Posix as Posix
|
|
import qualified Utility.LockPool.PidLock as Pid
|
|
import Utility.LockFile.Posix (openLockFile)
|
|
import Utility.LockPool.STM (LockFile)
|
|
import Utility.LockPool.LockHandle
|
|
import Utility.LockFile.LockStatus
|
|
|
|
import System.Posix
|
|
|
|
lockShared :: Maybe FileMode -> LockFile -> Annex LockHandle
|
|
lockShared m f = pidLock m f $ Posix.lockShared m f
|
|
|
|
lockExclusive :: Maybe FileMode -> LockFile -> Annex LockHandle
|
|
lockExclusive m f = pidLock m f $ Posix.lockExclusive m f
|
|
|
|
tryLockShared :: Maybe FileMode -> LockFile -> Annex (Maybe LockHandle)
|
|
tryLockShared m f = tryPidLock m f $ Posix.tryLockShared m f
|
|
|
|
tryLockExclusive :: Maybe FileMode -> LockFile -> Annex (Maybe LockHandle)
|
|
tryLockExclusive m f = tryPidLock m f $ Posix.tryLockExclusive m f
|
|
|
|
checkLocked :: LockFile -> Annex (Maybe Bool)
|
|
checkLocked f = Posix.checkLocked f
|
|
`pidLockCheck` Pid.checkLocked
|
|
|
|
getLockStatus :: LockFile -> Annex LockStatus
|
|
getLockStatus f = Posix.getLockStatus f
|
|
`pidLockCheck` Pid.getLockStatus
|
|
|
|
pidLockFile :: Annex (Maybe FilePath)
|
|
pidLockFile = ifM (annexPidLock <$> Annex.getGitConfig)
|
|
( Just <$> fromRepo gitAnnexPidLockFile
|
|
, pure Nothing
|
|
)
|
|
|
|
pidLockCheck :: IO a -> (LockFile -> IO a) -> Annex a
|
|
pidLockCheck posixcheck pidcheck =
|
|
liftIO . maybe posixcheck pidcheck =<< pidLockFile
|
|
|
|
pidLock :: Maybe FileMode -> LockFile -> IO LockHandle -> Annex LockHandle
|
|
pidLock m f posixlock = go =<< pidLockFile
|
|
where
|
|
go Nothing = liftIO posixlock
|
|
go (Just pidlock) = do
|
|
timeout <- annexPidLockTimeout <$> Annex.getGitConfig
|
|
liftIO $ do
|
|
dummyPosixLock m f
|
|
Pid.waitLock timeout pidlock
|
|
|
|
tryPidLock :: Maybe FileMode -> LockFile -> IO (Maybe LockHandle) -> Annex (Maybe LockHandle)
|
|
tryPidLock m f posixlock = liftIO . go =<< pidLockFile
|
|
where
|
|
go Nothing = posixlock
|
|
go (Just pidlock) = do
|
|
dummyPosixLock m f
|
|
Pid.tryLock pidlock
|
|
|
|
-- The posix lock file is created even when using pid locks, in order to
|
|
-- avoid complicating any code that might expect to be able to see that
|
|
-- lock file.
|
|
dummyPosixLock :: Maybe FileMode -> LockFile -> IO ()
|
|
dummyPosixLock m f = closeFd =<< openLockFile ReadLock m f
|