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).
This commit is contained in:
Joey Hess 2013-03-18 20:34:56 -04:00
parent 4ce25e8986
commit b543842a7f
2 changed files with 25 additions and 15 deletions

View file

@ -18,6 +18,8 @@ import Logs.Transfer
import Logs.Location import Logs.Location
import Annex.Content import Annex.Content
import qualified Remote import qualified Remote
import qualified Types.Remote as Remote
import qualified Git
import Types.Key import Types.Key
import Locations.UserConfig import Locations.UserConfig
import Assistant.Threads.TransferWatcher import Assistant.Threads.TransferWatcher
@ -44,18 +46,24 @@ startTransfer
-> TransferInfo -> TransferInfo
-> Assistant (Maybe (Transfer, TransferInfo, Assistant ())) -> Assistant (Maybe (Transfer, TransferInfo, Assistant ()))
startTransfer program t info = case (transferRemote info, associatedFile info) of startTransfer program t info = case (transferRemote info, associatedFile info) of
(Just remote, Just file) -> ifM (liftAnnex $ shouldTransfer t info) (Just remote, Just file)
( do | Git.repoIsLocalUnknown (Remote.repo remote) -> do
debug [ "Transferring:" , describeTransfer t info ] -- optimisation for removable drives not plugged in
notifyTransfer liftAnnex $ recordFailedTransfer t info
return $ Just (t, info, transferprocess remote file)
, do
debug [ "Skipping unnecessary transfer:",
describeTransfer t info ]
void $ removeTransfer t void $ removeTransfer t
finishedTransfer t (Just info)
return Nothing 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 _ -> return Nothing
where where
direction = transferDirection t direction = transferDirection t

View file

@ -115,7 +115,7 @@ runTransfer t file shouldretry a = do
mode <- annexFileMode mode <- annexFileMode
ok <- retry info metervar $ ok <- retry info metervar $
bracketIO (prep tfile mode info) (cleanup tfile) (a meter) bracketIO (prep tfile mode info) (cleanup tfile) (a meter)
unless ok $ failed info unless ok $ recordFailedTransfer t info
return ok return ok
where where
prep tfile mode info = catchMaybeIO $ do prep tfile mode info = catchMaybeIO $ do
@ -132,10 +132,6 @@ runTransfer t file shouldretry a = do
void $ tryIO $ removeFile tfile void $ tryIO $ removeFile tfile
void $ tryIO $ removeFile $ transferLockFile tfile void $ tryIO $ removeFile $ transferLockFile tfile
closeFd fd closeFd fd
failed info = do
failedtfile <- fromRepo $ failedTransferFile t
createAnnexDirectory $ takeDirectory failedtfile
liftIO $ writeTransferInfoFile info failedtfile
retry oldinfo metervar run = do retry oldinfo metervar run = do
v <- tryAnnex run v <- tryAnnex run
case v of case v of
@ -236,6 +232,12 @@ removeFailedTransfer t = do
f <- fromRepo $ failedTransferFile t f <- fromRepo $ failedTransferFile t
liftIO $ void $ tryIO $ removeFile f 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. -} {- The transfer information file to use for a given Transfer. -}
transferFile :: Transfer -> Git.Repo -> FilePath transferFile :: Transfer -> Git.Repo -> FilePath
transferFile (Transfer direction u key) r = transferDir direction r transferFile (Transfer direction u key) r = transferDir direction r