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 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

View file

@ -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