record transfer information on local git remotes

In order to record a semi-useful filename associated with the key,
this required plumbing the filename all the way through to the remotes'
storeKey and retrieveKeyFile.

Note that there is potential for deadlock here, narrowly avoided.
Suppose the repos are A and B. A sends file foo to B, and at the same
time, B gets file foo from A. So, A locks its upload transfer info file,
and then locks B's download transfer info file. At the same time,
B is taking the two locks in the opposite order. This is only not a
deadlock because the lock code does not wait, and aborts. So one of A or
B's transfers will be aborted and the other transfer will continue.
Whew!

Command/Fsck.hs

@@ -94,7 +94,7 @@ performRemote key file backend numcopies remote =
 				( return True
 				, ifM (Annex.getState Annex.fast)
 					( return False
-					, Remote.retrieveKeyFile remote key tmp
+					, Remote.retrieveKeyFile remote key Nothing tmp
 					)
 				)
 

Command/Get.hs

@@ -65,7 +65,7 @@ getKeyFile key file dest = dispatch =<< Remote.keyPossibilities key
 			| Remote.hasKeyCheap r =
 				either (const False) id <$> Remote.hasKey r key
 			| otherwise = return True
-		docopy r continue = download r key file $ do
+		docopy r continue = download (Remote.uuid r) key (Just file) $ do
 			showAction $ "from " ++ Remote.name r
-			ifM (Remote.retrieveKeyFile r key dest)
+			ifM (Remote.retrieveKeyFile r key (Just file) dest)
 				( return True , continue)

Command/Move.hs

@@ -89,7 +89,8 @@ toPerform dest move key file = moveLock move key $ do
 			stop
 		Right False -> do
 			showAction $ "to " ++ Remote.name dest
-			ok <- upload dest key file $ Remote.storeKey dest key
+			ok <- upload (Remote.uuid dest) key (Just file) $
+				Remote.storeKey dest key (Just file)
 			if ok
 				then finish
 				else do
@@ -134,9 +135,10 @@ fromPerform :: Remote -> Bool -> Key -> FilePath -> CommandPerform
 fromPerform src move key file = moveLock move key $
 	ifM (inAnnex key)
 		( handle move True
-		, download src key file $ do
+		, download (Remote.uuid src) key (Just file) $ do
 			showAction $ "from " ++ Remote.name src
-			ok <- getViaTmp key $ Remote.retrieveKeyFile src key
+			ok <- getViaTmp key $
+				Remote.retrieveKeyFile src key (Just file)
 			handle move ok
 		)
 	where

Command/Status.hs

@@ -31,6 +31,7 @@ import Logs.Trust
 import Remote
 import Config
 import Utility.Percentage
+import Logs.Transfer
 
 -- a named computation that produces a statistic
 type Stat = StatState (Maybe (String, StatState String))
@@ -70,6 +71,7 @@ fast_stats =
 	, remote_list SemiTrusted "semitrusted"
 	, remote_list UnTrusted "untrusted"
 	, remote_list DeadTrusted "dead"
+	, transfer_list
 	, disk_size
 	]
 slow_stats :: [Stat]
@@ -170,6 +172,24 @@ bloom_info = stat "bloom filter size" $ json id $ do
 
 	return $ size ++ note
 
+transfer_list :: Stat
+transfer_list = stat "transfers in progress" $ nojson $ lift $ do
+	uuidmap <- Remote.remoteMap id
+	ts <- getTransfers
+	if null ts
+		then return "none"
+		else return $ pp uuidmap "" $ sort ts
+	where
+		pp _ c [] = c
+		pp uuidmap c ((t, i):xs) = "\n\t" ++ line uuidmap t i ++ pp uuidmap c xs
+		line uuidmap t i = unwords
+			[ show (transferDirection t) ++ "ing"
+			, fromMaybe (show $ transferKey t) (associatedFile i)
+			, if transferDirection t == Upload then "to" else "from"
+			, maybe (fromUUID $ transferRemote t) Remote.name $
+				M.lookup (transferRemote t) uuidmap
+			]
+
 disk_size :: Stat
 disk_size = stat "available local disk space" $ json id $ lift $
 	calcfree