2015-11-12 20:31:34 +00:00
|
|
|
{- Pid locks, using lock pools.
|
|
|
|
-
|
|
|
|
- Copyright 2015 Joey Hess <id@joeyh.name>
|
|
|
|
-
|
|
|
|
- License: BSD-2-clause
|
|
|
|
-}
|
|
|
|
|
|
|
|
module Utility.LockPool.PidLock (
|
|
|
|
P.LockFile,
|
|
|
|
LockHandle,
|
|
|
|
waitLock,
|
|
|
|
tryLock,
|
|
|
|
checkLocked,
|
|
|
|
getLockStatus,
|
|
|
|
LockStatus(..),
|
|
|
|
dropLock,
|
|
|
|
checkSaneLock,
|
|
|
|
) where
|
|
|
|
|
|
|
|
import qualified Utility.LockFile.PidLock as F
|
|
|
|
import Utility.LockFile.LockStatus
|
|
|
|
import qualified Utility.LockPool.STM as P
|
|
|
|
import Utility.LockPool.STM (LockFile, LockMode(..))
|
|
|
|
import Utility.LockPool.LockHandle
|
2015-11-12 21:12:54 +00:00
|
|
|
import Utility.ThreadScheduler
|
2015-11-12 20:31:34 +00:00
|
|
|
|
|
|
|
import System.IO
|
|
|
|
import System.Posix
|
|
|
|
import Data.Maybe
|
|
|
|
import Control.Applicative
|
|
|
|
import Prelude
|
|
|
|
|
2015-11-12 21:12:54 +00:00
|
|
|
-- Takes a pid lock, blocking until the lock is available or the timeout.
|
|
|
|
waitLock :: Seconds -> LockFile -> IO LockHandle
|
Fix shared lock file FD leak.
This fixes behavior in this situation:
l1 <- lockShared Nothing "lck"
l2 <- lockShared Nothing "lck"
dropLock l1
dropLock l2
Before, the lock was dropped upon the second dropLock call, but the fd
remained open, and would never be closed while the program was running.
Fixed by a rather round-about method, but it should work well enough.
It would have been simpler to open open the shared lock once, and not open
it again in the second call to lockShared. But, that's difficult to do
atomically.
This also affects Windows and PID locks, not just posix locks.
In the case of pid locks, multiple calls to waitLock within the same
process are allowed because the side lock is locked using a posix lock,
and so multiple exclusive locks can be taken in the same process. So,
this change fixes a similar problem with pid locks.
l1 <- waitLock (Seconds 1) "lck"
l2 <- waitLock (Seconds 1) "lck"
dropLock l1
dropLock l2
Here the l2 side lock fd remained open but not locked,
although the pid lock file was removed. After this change, the second
dropLock will close both fds to the side lock, and delete the pidlock.
2016-03-01 19:31:39 +00:00
|
|
|
waitLock timeout file = makeLockHandle P.lockPool file
|
2016-03-01 17:47:49 +00:00
|
|
|
-- LockShared for STM lock, because a pid lock can be the top-level
|
|
|
|
-- lock with various other STM level locks gated behind it.
|
Fix shared lock file FD leak.
This fixes behavior in this situation:
l1 <- lockShared Nothing "lck"
l2 <- lockShared Nothing "lck"
dropLock l1
dropLock l2
Before, the lock was dropped upon the second dropLock call, but the fd
remained open, and would never be closed while the program was running.
Fixed by a rather round-about method, but it should work well enough.
It would have been simpler to open open the shared lock once, and not open
it again in the second call to lockShared. But, that's difficult to do
atomically.
This also affects Windows and PID locks, not just posix locks.
In the case of pid locks, multiple calls to waitLock within the same
process are allowed because the side lock is locked using a posix lock,
and so multiple exclusive locks can be taken in the same process. So,
this change fixes a similar problem with pid locks.
l1 <- waitLock (Seconds 1) "lck"
l2 <- waitLock (Seconds 1) "lck"
dropLock l1
dropLock l2
Here the l2 side lock fd remained open but not locked,
although the pid lock file was removed. After this change, the second
dropLock will close both fds to the side lock, and delete the pidlock.
2016-03-01 19:31:39 +00:00
|
|
|
(\p f -> P.waitTakeLock p f LockShared)
|
|
|
|
(\f -> mk <$> F.waitLock timeout f)
|
2015-11-12 20:31:34 +00:00
|
|
|
|
|
|
|
-- Tries to take a pid lock, but does not block.
|
|
|
|
tryLock :: LockFile -> IO (Maybe LockHandle)
|
Fix shared lock file FD leak.
This fixes behavior in this situation:
l1 <- lockShared Nothing "lck"
l2 <- lockShared Nothing "lck"
dropLock l1
dropLock l2
Before, the lock was dropped upon the second dropLock call, but the fd
remained open, and would never be closed while the program was running.
Fixed by a rather round-about method, but it should work well enough.
It would have been simpler to open open the shared lock once, and not open
it again in the second call to lockShared. But, that's difficult to do
atomically.
This also affects Windows and PID locks, not just posix locks.
In the case of pid locks, multiple calls to waitLock within the same
process are allowed because the side lock is locked using a posix lock,
and so multiple exclusive locks can be taken in the same process. So,
this change fixes a similar problem with pid locks.
l1 <- waitLock (Seconds 1) "lck"
l2 <- waitLock (Seconds 1) "lck"
dropLock l1
dropLock l2
Here the l2 side lock fd remained open but not locked,
although the pid lock file was removed. After this change, the second
dropLock will close both fds to the side lock, and delete the pidlock.
2016-03-01 19:31:39 +00:00
|
|
|
tryLock file = tryMakeLockHandle P.lockPool file
|
|
|
|
(\p f -> P.tryTakeLock p f LockShared)
|
|
|
|
(\f -> fmap mk <$> F.tryLock f)
|
2015-11-12 20:31:34 +00:00
|
|
|
|
|
|
|
checkLocked :: LockFile -> IO (Maybe Bool)
|
|
|
|
checkLocked file = P.getLockStatus P.lockPool file
|
|
|
|
(pure (Just True))
|
|
|
|
(F.checkLocked file)
|
|
|
|
|
|
|
|
getLockStatus :: LockFile -> IO LockStatus
|
|
|
|
getLockStatus file = P.getLockStatus P.lockPool file
|
|
|
|
(StatusLockedBy <$> getProcessID)
|
|
|
|
(F.getLockStatus file)
|
|
|
|
|
|
|
|
mk :: F.LockHandle -> FileLockOps
|
|
|
|
mk h = FileLockOps
|
|
|
|
{ fDropLock = F.dropLock h
|
|
|
|
, fCheckSaneLock = \f -> F.checkSaneLock f h
|
|
|
|
}
|