From 9acd2ee80f357d34eee7335f775b47bec87f4aed Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Mon, 18 Mar 2013 20:34:56 -0400 Subject: 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). --- Assistant/Threads/Transferrer.hs | 28 ++++++++++++++++++---------- Logs/Transfer.hs | 12 +++++++----- 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 -- cgit v1.2.3