diff options
Diffstat (limited to 'Utility')
| -rw-r--r-- | Utility/LockFile/PidLock.hs | 17 | ||||
| -rw-r--r-- | Utility/LockPool/PidLock.hs | 11 |
2 files changed, 16 insertions, 12 deletions
diff --git a/Utility/LockFile/PidLock.hs b/Utility/LockFile/PidLock.hs index e968f1861..ac1df253d 100644 --- a/Utility/LockFile/PidLock.hs +++ b/Utility/LockFile/PidLock.hs @@ -25,6 +25,7 @@ import Utility.Monad import Utility.Path import Utility.FileMode import Utility.LockFile.LockStatus +import Utility.ThreadScheduler import qualified Utility.LockFile.Posix as Posix import System.IO @@ -101,7 +102,7 @@ tryLock lockfile = trySideLock lockfile $ \sidelock -> do Just pl | isJust sidelock && hn == lockingHost pl -> do -- Since we have the sidelock, -- and are on the same host that - -- the pidlock was take on, + -- the pidlock was taken on, -- we know that the pidlock is -- stale, and can take it over. rename tmp lockfile @@ -113,13 +114,17 @@ tryLock lockfile = trySideLock lockfile $ \sidelock -> do -- -- Uses a 1 second wait-loop. -- --- May wait forever if the lock file is stale and is on a network file +-- May wait untie timeout if the lock file is stale and is on a network file -- system, or on a system where the side lock cannot be taken. -waitLock :: LockFile -> IO LockHandle -waitLock lockfile = go +waitLock :: Seconds -> LockFile -> IO LockHandle +waitLock (Seconds timeout) lockfile = go timeout where - go = maybe (threadDelaySeconds (Seconds 1) >> go) return - =<< tryLock lockfile + go n + | n > 0 = maybe (threadDelaySeconds (Seconds 1) >> go (pred n)) return + =<< tryLock lockfile + | otherwise = do + hPutStrLn stderr $ show timeout ++ " second timeout exceeded while waiting for pid lock file " ++ lockfile + error $ "Gave up waiting for possibly stale pid lock file " ++ lockfile dropLock :: LockHandle -> IO () dropLock (LockHandle lockfile fd plh) = do diff --git a/Utility/LockPool/PidLock.hs b/Utility/LockPool/PidLock.hs index dc796b961..dca353fdf 100644 --- a/Utility/LockPool/PidLock.hs +++ b/Utility/LockPool/PidLock.hs @@ -22,6 +22,7 @@ import Utility.LockFile.LockStatus import qualified Utility.LockPool.STM as P import Utility.LockPool.STM (LockFile, LockMode(..)) import Utility.LockPool.LockHandle +import Utility.ThreadScheduler import System.IO import System.Posix @@ -29,13 +30,11 @@ import Data.Maybe import Control.Applicative import Prelude --- Takes a pid lock, blocking until the lock is available. --- --- May block forever on stale locks, see PidLock documentation for details. -waitLock :: LockFile -> IO LockHandle -waitLock file = makeLockHandle +-- Takes a pid lock, blocking until the lock is available or the timeout. +waitLock :: Seconds -> LockFile -> IO LockHandle +waitLock timeout file = makeLockHandle (P.waitTakeLock P.lockPool file LockExclusive) - (mk <$> F.waitLock file) + (mk <$> F.waitLock timeout file) -- Tries to take a pid lock, but does not block. tryLock :: LockFile -> IO (Maybe LockHandle) |