summaryrefslogtreecommitdiff
path: root/Annex/LockPool/PosixOrPid.hs
blob: ecf96d51fbb1760821f2c64dbd32e161e695e956 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
{- 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
import Types
import Annex.Locations
import qualified Annex
import qualified Utility.LockPool.Posix as Posix
import qualified Utility.LockPool.PidLock as Pid
import qualified Utility.LockPool.LockHandle as H
import Utility.LockPool.LockHandle (LockHandle, dropLock)
import Utility.LockFile.Posix (openLockFile)
import Utility.LockPool.STM (LockFile)
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

checkSaneLock :: LockFile -> LockHandle -> Annex Bool
checkSaneLock f h = H.checkSaneLock f h
	`pidLockCheck` flip Pid.checkSaneLock h

pidLockFile :: Annex (Maybe FilePath)
pidLockFile = ifM (annexPidLock <$> Annex.getGitConfig)
	( Just <$> Annex.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