summaryrefslogtreecommitdiff
path: root/Utility/LockFile
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@joeyh.name>2015-11-12 17:12:54 -0400
committerGravatar Joey Hess <joeyh@joeyh.name>2015-11-12 17:12:54 -0400
commit00fdc3063fe586cdce35ba8dbe2f1b024479522c (patch)
treee6e593c87ceba3d5adcc27e53ded216e4cdb474a /Utility/LockFile
parentd94a72a381baf0e251db48844d27755d5f2c8f14 (diff)
add timeout for pid lock waiting
Diffstat (limited to 'Utility/LockFile')
-rw-r--r--Utility/LockFile/PidLock.hs17
1 files changed, 11 insertions, 6 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