optimisation for transfers to drives that are not plugged in

Rather than forking a git-annex transferkey only to have it fail,
just immediately record the failed transfer (so when the drive is plugged
in, the scan will retry it).

2 files changed, 25 insertions, 15 deletions

diff --git a/Assistant/Threads/Transferrer.hs b/Assistant/Threads/Transferrer.hs
index 63306831f..2c487657a 100644
--- a/Assistant/Threads/Transferrer.hs
+++ b/Assistant/Threads/Transferrer.hs
@@ -18,6 +18,8 @@ import Logs.Transfer
 import Logs.Location
 import Annex.Content
 import qualified Remote
+import qualified Types.Remote as Remote
+import qualified Git
 import Types.Key
 import Locations.UserConfig
 import Assistant.Threads.TransferWatcher
@@ -44,18 +46,24 @@ startTransfer
 	-> TransferInfo
 	-> Assistant (Maybe (Transfer, TransferInfo, Assistant ()))
 startTransfer program t info = case (transferRemote info, associatedFile info) of
-	(Just remote, Just file) -> ifM (liftAnnex $ shouldTransfer t info)
-		( do
-			debug [ "Transferring:" , describeTransfer t info ]
-			notifyTransfer
-			return $ Just (t, info, transferprocess remote file)
-		, do
-			debug [ "Skipping unnecessary transfer:",
-				describeTransfer t info ]
+	(Just remote, Just file) 
+		| Git.repoIsLocalUnknown (Remote.repo remote) -> do
+			-- optimisation for removable drives not plugged in
+			liftAnnex $ recordFailedTransfer t info
 			void $ removeTransfer t
-			finishedTransfer t (Just info)
 			return Nothing
-		)
+		| otherwise -> ifM (liftAnnex $ shouldTransfer t info)
+			( do
+				debug [ "Transferring:" , describeTransfer t info ]
+				notifyTransfer
+				return $ Just (t, info, transferprocess remote file)
+			, do
+				debug [ "Skipping unnecessary transfer:",
+					describeTransfer t info ]
+				void $ removeTransfer t
+				finishedTransfer t (Just info)
+				return Nothing
+			)
 	_ -> return Nothing
   where
 	direction = transferDirection t
diff --git a/Logs/Transfer.hs b/Logs/Transfer.hs
index 6d6d3d890..c6f240be0 100644
--- a/Logs/Transfer.hs
+++ b/Logs/Transfer.hs
@@ -115,7 +115,7 @@ runTransfer t file shouldretry a = do
 	mode <- annexFileMode
 	ok <- retry info metervar $
 		bracketIO (prep tfile mode info) (cleanup tfile) (a meter)
-	unless ok $ failed info
+	unless ok $ recordFailedTransfer t info
 	return ok
   where
 	prep tfile mode info = catchMaybeIO $ do
@@ -132,10 +132,6 @@ runTransfer t file shouldretry a = do
 		void $ tryIO $ removeFile tfile
 		void $ tryIO $ removeFile $ transferLockFile tfile
 		closeFd fd
-	failed info = do
-		failedtfile <- fromRepo $ failedTransferFile t
-		createAnnexDirectory $ takeDirectory failedtfile
-		liftIO $ writeTransferInfoFile info failedtfile
 	retry oldinfo metervar run = do
 		v <- tryAnnex run
 		case v of
@@ -236,6 +232,12 @@ removeFailedTransfer t = do
 	f <- fromRepo $ failedTransferFile t
 	liftIO $ void $ tryIO $ removeFile f
 
+recordFailedTransfer :: Transfer -> TransferInfo -> Annex ()
+recordFailedTransfer t info = do
+	failedtfile <- fromRepo $ failedTransferFile t
+	createAnnexDirectory $ takeDirectory failedtfile
+	liftIO $ writeTransferInfoFile info failedtfile
+
 {- The transfer information file to use for a given Transfer. -}
 transferFile :: Transfer -> Git.Repo -> FilePath
 transferFile (Transfer direction u key) r = transferDir direction r