avoid concurrent threads trying to take pid lock at same time

Seem there are several races that happen when 2 threads run PidLock.tryLock
at the same time. One involves checkSaneLock of the side lock file, which may
be deleted by another process that is dropping the lock, causing checkSaneLock
to fail. And even with the deletion disabled, it can still fail, Probably due
to linkToLock failing when a second thread overwrites the lock file.

The same can happen when 2 processes do, but then one process just fails
to take the lock, which is fine. But with 2 threads, some actions where failing
even though the process as a whole had the pid lock held.

Utility.LockPool.PidLock already maintains a STM lock, and since it uses
LockShared, 2 threads can hold the pidlock at the same time, and when
the first thread drops the lock, it will remain held by the second
thread, and so the pid lock file should not get deleted until the last
thread to hold it drops the lock. Which is the right behavior, and why a
LockShared STM lock is used in the first place.

The problem is that each time it takes the STM lock, it then also calls
PidLock.tryLock. So that was getting called repeatedly and concurrently.

Fixed by noticing when the shared lock is already held, and stop calling
PidLock.tryLock again, just use the pid lock that already exists then.

Also, LockFile.PidLock.tryLock was deleting the pid lock when it failed
to take the lock, which was entirely wrong. It should only drop the side
lock.

Sponsored-by: Dartmouth College's Datalad project

Utility/LockPool/LockHandle.hs

@@ -52,33 +52,33 @@ makeLockHandle
 	:: (MonadIO m, MonadMask m)
 	=> P.LockPool
 	-> LockFile
-	-> (P.LockPool -> LockFile -> STM P.LockHandle)
-	-> (LockFile -> m FileLockOps)
+	-> (P.LockPool -> LockFile -> STM (P.LockHandle, P.FirstLock))
+	-> (LockFile -> P.FirstLock -> m FileLockOps)
 	-> m LockHandle
 makeLockHandle pool file pa fa = bracketOnError setup cleanup go
   where
 	setup = debugLocks $ liftIO $ atomically (pa pool file)
-	cleanup ph = debugLocks $ liftIO $ P.releaseLock ph
-	go ph = liftIO . mkLockHandle ph =<< fa file
+	cleanup (ph, _) = debugLocks $ liftIO $ P.releaseLock ph
+	go (ph, firstlock) = liftIO . mkLockHandle ph =<< fa file firstlock
 
 tryMakeLockHandle
 	:: (MonadIO m, MonadMask m)
 	=> P.LockPool
 	-> LockFile
-	-> (P.LockPool -> LockFile -> STM (Maybe P.LockHandle))
-	-> (LockFile -> m (Maybe FileLockOps))
+	-> (P.LockPool -> LockFile -> STM (Maybe (P.LockHandle, P.FirstLock)))
+	-> (LockFile -> P.FirstLock -> m (Maybe FileLockOps))
 	-> m (Maybe LockHandle)
 tryMakeLockHandle pool file pa fa = bracketOnError setup cleanup go
   where
 	setup = liftIO $ atomically (pa pool file)
 	cleanup Nothing = return ()
-	cleanup (Just ph) = liftIO $ P.releaseLock ph
+	cleanup (Just (ph, _)) = liftIO $ P.releaseLock ph
 	go Nothing = return Nothing
-	go (Just ph) = do
-		mfo <- fa file
+	go (Just (ph, firstlock)) = do
+		mfo <- fa file firstlock
 		case mfo of
 			Nothing -> do
-				liftIO $ cleanup (Just ph)
+				liftIO $ cleanup (Just (ph, firstlock))
 				return Nothing
 			Just fo -> liftIO $ Just <$> mkLockHandle ph fo
 
@@ -86,4 +86,4 @@ mkLockHandle :: P.LockHandle -> FileLockOps -> IO LockHandle
 mkLockHandle ph fo = do
 	atomically $ P.registerCloseLockFile ph (fDropLock fo)
 	return $ LockHandle ph fo
-	
+