info: Improve cleanup of stale transfer info files.

In my git-annex repos, I found some stale transfer info files
without lock files.

Pass a mode to tryLockExclusive, so it will create the lock file if
not present, and so not fail to clean up such transfer info files.

Normally, transfer info files are accompanied by a lock file.
But, when alwaysRunTransfer is used, the locking can fail
and it will still write the transfer info file. Perhaps there are other
cases too? Note that mkProgressUpdater's meter
writes to the transfer info file too, and it might be possible for
that meter to fire after runTransfer has cleaned up.

This commit was sponsored by andrea rota.

1 files changed, 7 insertions, 6 deletions

diff --git a/Logs/Transfer.hs b/Logs/Transfer.hs
index aef233b77..0aded154d 100644
--- a/Logs/Transfer.hs
+++ b/Logs/Transfer.hs
@@ -93,22 +93,23 @@ startTransferInfo afile = TransferInfo
 checkTransfer :: Transfer -> Annex (Maybe TransferInfo)
 checkTransfer t = do
 	tfile <- fromRepo $ transferFile t
+	let lck = transferLockFile tfile
 	let cleanstale = do
 		void $ tryIO $ removeFile tfile
-		void $ tryIO $ removeFile $ transferLockFile tfile
+		void $ tryIO $ removeFile lck
 #ifndef mingw32_HOST_OS
-	let lck = transferLockFile tfile
 	v <- getLockStatus lck
 	case v of
 		StatusLockedBy pid -> liftIO $ catchDefaultIO Nothing $
 			readTransferInfoFile (Just pid) tfile
-		StatusNoLockFile -> return Nothing
-		StatusUnLocked -> do
+		_ -> do
 			-- Take a non-blocking lock while deleting
 			-- the stale lock file. Ignore failure
 			-- due to permissions problems, races, etc.
 			void $ tryIO $ do
-				r <- tryLockExclusive Nothing lck
+				mode <- annexFileMode
+				let lck = transferLockFile tfile
+				r <- tryLockExclusive (Just mode) lck
 				case r of
 					Just lockhandle -> liftIO $ do
 						cleanstale
@@ -116,7 +117,7 @@ checkTransfer t = do
 					_ -> noop
 			return Nothing
 #else
-	v <- liftIO $ lockShared $ transferLockFile tfile
+	v <- liftIO $ lockShared lck
 	liftIO $ case v of
 		Nothing -> catchDefaultIO Nothing $
 			readTransferInfoFile Nothing tfile