mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

make the assistant retry failed transfers

Browse source 
When a transfer fails, the progress info can be used to intelligently
retry it. If the transfer managed to make some progress, but did not
fully complete, then there's a good chance that a retry will finish it
(or at least make more progress).
This commit is contained in:
Joey Hess 2012-09-23 13:27:13 -04:00
parent d4055b3dd2
commit df07ccf404
6 changed files with 37 additions and 17 deletions
Download patch file Download diff file Expand all files Collapse all files

2
Command/Get.hs
View file

@ -66,7 +66,7 @@ getKeyFile key file dest = dispatch =<< Remote.keyPossibilities key
either (const False) id <$> Remote.hasKey r key
| otherwise = return True
docopy r continue = do
ok <- download (Remote.uuid r) key (Just file) $ do
ok <- download (Remote.uuid r) key (Just file) noRetry $ do
showAction $ "from " ++ Remote.name r
Remote.retrieveKeyFile r key (Just file) dest
if ok then return ok else continue

4
Command/Move.hs
View file

@ -89,7 +89,7 @@ toPerform dest move key file = moveLock move key $ do
stop
Right False -> do
showAction $ "to " ++ Remote.name dest
ok <- upload (Remote.uuid dest) key (Just file) $
ok <- upload (Remote.uuid dest) key (Just file) noRetry $
Remote.storeKey dest key (Just file)
if ok
then finish
@ -138,7 +138,7 @@ fromPerform src move key file = moveLock move key $
, handle move =<< go
)
where
go = download (Remote.uuid src) key (Just file) $ do
go = download (Remote.uuid src) key (Just file) noRetry $ do
showAction $ "from " ++ Remote.name src
getViaTmp key $ Remote.retrieveKeyFile src key (Just file)
handle _ False = stop -- failed

4
Command/SendKey.hs
View file

@ -24,7 +24,7 @@ seek = [withKeys start]
start :: Key -> CommandStart
start key = ifM (inAnnex key)
( fieldTransfer Upload key $ \p -> do
( fieldTransfer Upload key $ \_p -> do
file <- inRepo $ gitAnnexLocation key
liftIO $ rsyncServerSend file
, do
@ -36,7 +36,7 @@ fieldTransfer :: Direction -> Key -> (MeterUpdate -> Annex Bool) -> CommandStart
fieldTransfer direction key a = do
afile <- Fields.getField Fields.associatedFile
ok <- maybe (a $ const noop)
(\u -> runTransfer (Transfer direction (toUUID u) key) afile a)
(\u -> runTransfer (Transfer direction (toUUID u) key) afile noRetry a)
=<< Fields.getField Fields.remoteUUID
if ok
then liftIO exitSuccess

4
Command/TransferKey.hs
View file

@ -43,7 +43,7 @@ start to from file key =
toPerform :: Remote -> Key -> AssociatedFile -> CommandPerform
toPerform remote key file = next $
upload (uuid remote) key file $ \p -> do
upload (uuid remote) key file forwardRetry $ \p -> do
ok <- Remote.storeKey remote key file p
when ok $
Remote.logStatus remote key InfoPresent
@ -51,5 +51,5 @@ toPerform remote key file = next $
fromPerform :: Remote -> Key -> AssociatedFile -> CommandPerform
fromPerform remote key file = next $
download (uuid remote) key file $
download (uuid remote) key file forwardRetry $
getViaTmp key $ Remote.retrieveKeyFile remote key file