keep logs of failed transfers, and requeue them when doing a non-full scan

of a remote

3 files changed, 18 insertions, 9 deletions

diff --git a/Command/Move.hs b/Command/Move.hs
index e7c11e80d..7955cecd3 100644
--- a/Command/Move.hs
+++ b/Command/Move.hs
@@ -135,13 +135,12 @@ fromPerform :: Remote -> Bool -> Key -> FilePath -> CommandPerform
 fromPerform src move key file = moveLock move key $
 	ifM (inAnnex key)
 		( handle move True
-		, download (Remote.uuid src) key (Just file) $ do
-			showAction $ "from " ++ Remote.name src
-			ok <- getViaTmp key $
-				Remote.retrieveKeyFile src key (Just file)
-			handle move ok
+		, handle move =<< go
 		)
 	where
+		go = download (Remote.uuid src) key (Just file) $ do
+			showAction $ "from " ++ Remote.name src
+			getViaTmp key $ Remote.retrieveKeyFile src key (Just file)
 		handle _ False = stop -- failed
 		handle False True = next $ return True -- copy complete
 		handle True True = do -- finish moving
diff --git a/Command/RecvKey.hs b/Command/RecvKey.hs
index ce8bff997..0606f9c51 100644
--- a/Command/RecvKey.hs
+++ b/Command/RecvKey.hs
@@ -13,6 +13,7 @@ import CmdLine
 import Annex.Content
 import Utility.RsyncFile
 import Logs.Transfer
+import Command.SendKey (fieldTransfer)
 
 def :: [Command]
 def = [oneShot $ command "recvkey" paramKey seek
@@ -30,7 +31,7 @@ start key = ifM (inAnnex key)
 				-- forcibly quit after receiving one key,
 				-- and shutdown cleanly
 				_ <- shutdown True
-				liftIO exitSuccess
-			, liftIO exitFailure
+				return True
+			, return False
 			)
 	)
diff --git a/Command/SendKey.hs b/Command/SendKey.hs
index 5eca70d24..8f914b5ed 100644
--- a/Command/SendKey.hs
+++ b/Command/SendKey.hs
@@ -12,6 +12,7 @@ import Command
 import Annex.Content
 import Utility.RsyncFile
 import Logs.Transfer
+import qualified Fields
 
 def :: [Command]
 def = [oneShot $ command "sendkey" paramKey seek
@@ -24,9 +25,17 @@ start :: Key -> CommandStart
 start key = ifM (inAnnex key)
 	( fieldTransfer Upload key $ do
 		file <- inRepo $ gitAnnexLocation key
-		liftIO $ ifM (rsyncServerSend file)
-			( exitSuccess , exitFailure )
+		liftIO $ rsyncServerSend file
 	, do
 		warning "requested key is not present"
 		liftIO exitFailure
 	)
+
+fieldTransfer :: Direction -> Key -> Annex Bool -> CommandStart
+fieldTransfer direction key a = do
+	afile <- Fields.getField Fields.associatedFile
+	ok <- maybe a (\u -> runTransfer (Transfer direction (toUUID u) key) afile a)
+		=<< Fields.getField Fields.remoteUUID
+	if ok
+		then liftIO exitSuccess
+		else liftIO exitFailure