Fix an unlikely race that could result in two transfers of the same key running at once.

As discussed in bug report.
This commit is contained in:
Joey Hess 2015-05-12 19:39:28 -04:00
parent e25ecab7dd
commit 8c2dd7d8ee
4 changed files with 56 additions and 1 deletions

View file

@ -16,6 +16,7 @@ module Utility.LockFile.Posix (
checkLocked,
getLockStatus,
dropLock,
checkSaneLock,
) where
import Utility.Exception
@ -97,3 +98,17 @@ getLockStatus' lockfile = go =<< catchMaybeIO open
dropLock :: LockHandle -> IO ()
dropLock (LockHandle fd) = closeFd fd
-- Checks that the lock file still exists, and is the same file that was
-- locked to get the LockHandle.
--
-- This check is useful if the lock file might get deleted by something
-- else.
checkSaneLock :: LockFile -> LockHandle -> IO Bool
checkSaneLock lockfile (LockHandle fd) =
go =<< catchMaybeIO (getFileStatus lockfile)
where
go Nothing = return False
go (Just st) = do
fdst <- getFdStatus fd
return $ deviceID fdst == deviceID st && fileID fdst == fileID st