Fix reversion introduced in 6.20171214 that caused concurrent transfers to incorrectly fail with "transfer already in progress".

Avoid creating transfer info file before transfer lock is created and
locked.

The wrong order for one thing caused transfer info to be overwritten
when a transfer was already in progress.

But worse, it caused checkTransfer to see the transfer info,
and so lock the transfer lock in order to verify the transfer was not in
progress. Which in a concurrent situation, prevented the transferrer
from locking the transfer lock, so it failed with "transfer already in
progress".

Note that the transferinfo command does not lock the transfer lock
before creating the transfer info. But, that's only run after
recvkey is running, and recvkey does lock the transfer lock, so that
seems more or less ok. (Other than being a super complicated legacy mess
that the P2P code has mostly obsoleted now.)

This commit was supported by the NSF-funded DataLad project.

Annex/Transfer.hs

@@ -73,9 +73,9 @@ alwaysRunTransfer = runTransfer' True
 runTransfer' :: Observable v => Bool -> Transfer -> AssociatedFile -> RetryDecider -> (MeterUpdate -> Annex v) -> Annex v
 runTransfer' ignorelock t afile shouldretry transferaction = checkSecureHashes t $ do
 	info <- liftIO $ startTransferInfo afile
-	(meter, tfile, metervar) <- mkProgressUpdater t info
+	(meter, tfile, createtfile, metervar) <- mkProgressUpdater t info
 	mode <- annexFileMode
-	(lck, inprogress) <- prep tfile mode info
+	(lck, inprogress) <- prep tfile createtfile mode
 	if inprogress && not ignorelock
 		then do
 			showNote "transfer already in progress, or unable to take transfer lock"
@@ -89,30 +89,28 @@ runTransfer' ignorelock t afile shouldretry transferaction = checkSecureHashes t
 			return v
   where
 #ifndef mingw32_HOST_OS
-	prep tfile mode info = catchPermissionDenied (const prepfailed) $ do
+	prep tfile createtfile mode = catchPermissionDenied (const prepfailed) $ do
 		let lck = transferLockFile tfile
 		createAnnexDirectory $ takeDirectory lck
 		tryLockExclusive (Just mode) lck >>= \case
 			Nothing -> return (Nothing, True)
 			Just lockhandle -> ifM (checkSaneLock lck lockhandle)
 				( do
-					void $ tryIO $
+					createtfile
-						writeTransferInfoFile info tfile
 					return (Just lockhandle, False)
 				, do
 					liftIO $ dropLock lockhandle
 					return (Nothing, True)
 				)
 #else
-	prep tfile _mode info = catchPermissionDenied (const prepfailed) $ do
+	prep tfile createtfile _mode = catchPermissionDenied (const prepfailed) $ do
 		let lck = transferLockFile tfile
 		createAnnexDirectory $ takeDirectory lck
 		catchMaybeIO (liftIO $ lockExclusive lck) >>= \case
 			Nothing -> return (Nothing, False)
 			Just Nothing -> return (Nothing, True)
 			Just (Just lockhandle) -> do
-				void $ tryIO $
+				createtfile
-					writeTransferInfoFile info tfile
 				return (Just lockhandle, False)
 #endif
 	prepfailed = return (Nothing, False)

CHANGELOG

@@ -37,6 +37,8 @@ git-annex (6.20180228) UNRELEASED; urgency=medium
     thus the license of git-annex as a whole is AGPL. This was already
     the case when git-annex was built with the webapp enabled.
   * Include amount of data transferred in progress display.
+  * Fix reversion introduced in 6.20171214 that caused concurrent
+    transfers to incorrectly fail with "transfer already in progress".
 
  -- Joey Hess <id@joeyh.name>  Wed, 28 Feb 2018 11:53:03 -0400
 

Command/TransferInfo.hs

@@ -50,7 +50,8 @@ start (k:[]) = do
 				, transferKey = key
 				}
 			tinfo <- liftIO $ startTransferInfo afile
-			(update, tfile, _) <- mkProgressUpdater t tinfo
+			(update, tfile, createtfile, _) <- mkProgressUpdater t tinfo
+			createtfile
 			liftIO $ mapM_ void
 				[ tryIO $ forever $ do
 					bytes <- readUpdate

Logs/Transfer.hs

@@ -47,14 +47,17 @@ percentComplete (Transfer { transferKey = key }) info =
 	percentage <$> keySize key <*> Just (fromMaybe 0 $ bytesComplete info)
 
 {- Generates a callback that can be called as transfer progresses to update
- - the transfer info file. Also returns the file it'll be updating, and a
+ - the transfer info file. Also returns the file it'll be updating, 
- - MVar that can be used to read the number of bytesComplete. -}
+ - an action that sets up the file with appropriate permissions,
-mkProgressUpdater :: Transfer -> TransferInfo -> Annex (MeterUpdate, FilePath, MVar Integer)
+ - which should be run after locking the transfer lock file, but
+ - before using the callback, and a MVar that can be used to read
+ - the number of bytesComplete. -}
+mkProgressUpdater :: Transfer -> TransferInfo -> Annex (MeterUpdate, FilePath, Annex (), MVar Integer)
 mkProgressUpdater t info = do
 	tfile <- fromRepo $ transferFile t
-	_ <- tryNonAsync $ writeTransferInfoFile info tfile
+	let createtfile = void $ tryNonAsync $ writeTransferInfoFile info tfile
 	mvar <- liftIO $ newMVar 0
-	return (liftIO . updater tfile mvar, tfile, mvar)
+	return (liftIO . updater tfile mvar, tfile, createtfile, mvar)
   where
 	updater tfile mvar b = modifyMVar_ mvar $ \oldbytes -> do
 		let newbytes = fromBytesProcessed b

doc/bugs/get_-JX__58____transfer_already_in_progress_..._for_some_files.mdwn

@@ -29,3 +29,4 @@ Tried with bleeding edge 6.20180308+gitg3962ca71b-1~ndall+1 although originally
 
 [[!meta author=yoh]]
 
+> [[fixed|done]] --[[Joey]]

doc/bugs/get_-JX__58____transfer_already_in_progress_..._for_some_files/comment_6_e51841ae57dd9d2f48cd21fbdb90ac29._comment

@@ -0,0 +1,8 @@
+[[!comment format=mdwn
+ username="joey"
+ subject="""comment 6"""
+ date="2018-03-14T22:54:24Z"
+ content="""
+Ok, fixed the reversion in a fairly decent way,
+verified with 1000 files and -J10.
+"""]]