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