1{- Pid locks, using lock pools.
2 -
3 - Copyright 2015-2020 Joey Hess <id@joeyh.name>
4 -
5 - License: BSD-2-clause
6 -}
7
8module Utility.LockPool.PidLock (
9	P.LockFile,
10	LockHandle,
11	waitLock,
12	tryLock,
13	checkLocked,
14	getLockStatus,
15	LockStatus(..),
16	dropLock,
17	checkSaneLock,
18) where
19
20import qualified Utility.LockFile.PidLock as F
21import Utility.LockFile.LockStatus
22import qualified Utility.LockPool.STM as P
23import Utility.LockPool.STM (LockFile, LockMode(..))
24import Utility.LockPool.LockHandle
25import Utility.ThreadScheduler
26
27import System.IO
28import System.Posix
29import Data.Maybe
30import Control.Monad.Catch
31import Control.Monad.IO.Class
32import Control.Applicative
33import Prelude
34
35-- Takes a pid lock, blocking until the lock is available or the timeout.
36waitLock
37	:: (MonadIO m, MonadMask m)
38	=> Seconds
39	-> LockFile
40	-> (String -> m ())
41	-> m LockHandle
42waitLock timeout file displaymessage = makeLockHandle P.lockPool file
43	-- LockShared for STM lock, because a pid lock can be the top-level
44	-- lock with various other STM level locks gated behind it.
45	(\p f -> P.waitTakeLock p f LockShared)
46	(\f -> mk <$> F.waitLock timeout f displaymessage)
47
48-- Tries to take a pid lock, but does not block.
49tryLock :: LockFile -> IO (Maybe LockHandle)
50tryLock file = tryMakeLockHandle P.lockPool file
51	(\p f -> P.tryTakeLock p f LockShared)
52	(\f -> fmap mk <$> F.tryLock f)
53
54checkLocked :: LockFile -> IO (Maybe Bool)
55checkLocked file = P.getLockStatus P.lockPool file
56	(pure (Just True))
57	(F.checkLocked file)
58
59getLockStatus :: LockFile -> IO LockStatus
60getLockStatus file = P.getLockStatus P.lockPool file
61	(StatusLockedBy <$> getProcessID)
62	(F.getLockStatus file)
63
64mk :: F.LockHandle -> FileLockOps
65mk h = FileLockOps
66	{ fDropLock = F.dropLock h
67	, fCheckSaneLock = \f -> F.checkSaneLock f h
68	}
69