also compare lock file contents to double-check link worked

And it closes the tmp file before this. I don't know if this will help
avoid lustre's craziness, but it can't hurt..

1 files changed, 24 insertions, 12 deletions

diff --git a/Utility/LockFile/PidLock.hs b/Utility/LockFile/PidLock.hs
index 090250f89..d2bd31c36 100644
--- a/Utility/LockFile/PidLock.hs
+++ b/Utility/LockFile/PidLock.hs
@@ -99,17 +99,18 @@ tryLock lockfile = trySideLock lockfile $ \sidelock -> do
 	(tmp, h) <- openTempFile (takeDirectory lockfile) "locktmp"
 	setFileMode tmp (combineModes readModes)
 	hPutStr h . show =<< mkPidLock
-	fd <- handleToFd h
+	hClose h
 	let failedlock = do
-		closeFd fd
 		nukeFile tmp
+		maybe noop Posix.dropLock sidelock
 		return Nothing
-	let tooklock = return $ Just $ LockHandle lockfile fd sidelock
-	ifM (linkToLock sidelock tmp lockfile)
-		( do
+	let tooklock fd = return $ Just $ LockHandle lockfile fd sidelock
+	mfd <- linkToLock sidelock tmp lockfile
+	case mfd of
+		Just fd -> do
 			nukeFile tmp
-			tooklock
-		, do
+			tooklock fd
+		Nothing -> do
 			v <- readPidLock lockfile
 			hn <- getHostName
 			case v of
@@ -120,9 +121,9 @@ tryLock lockfile = trySideLock lockfile $ \sidelock -> do
 					-- we know that the pidlock is
 					-- stale, and can take it over.
 					rename tmp lockfile
-					tooklock
+					fd <- openFd lockfile ReadOnly Nothing defaultFileFlags
+					tooklock fd
 				_ -> failedlock
-		)
 
 -- Linux's open(2) man page recommends linking a pid lock into place,
 -- as the most portable atomic operation that will fail if
@@ -140,11 +141,22 @@ tryLock lockfile = trySideLock lockfile $ \sidelock -> do
 -- can't do anything about such a lying filesystem.
 -- At least the side lock file will prevent git-annex's running on the same
 -- host from running concurrently even on such a lying filesystem.
-linkToLock :: SideLockHandle -> FilePath -> FilePath -> IO Bool
-linkToLock Nothing _ _ = return False
+linkToLock :: SideLockHandle -> FilePath -> FilePath -> IO (Maybe Fd)
+linkToLock Nothing _ _ = return Nothing
 linkToLock (Just _) src dest = do
 	_ <- tryIO $ createLink src dest
-	catchDefaultIO False checklink
+	ifM (catchDefaultIO False checklink)
+		( catchDefaultIO Nothing $ do
+			srccontent <- readFile src
+			h <- openFile dest ReadMode
+			destcontent <- hGetContents h
+			if srccontent /= destcontent
+				then do
+					hClose h
+					return Nothing
+				else Just <$> handleToFd h
+		, return Nothing
+		)
   where
 	checklink = do
 		x <- getSymbolicLinkStatus src