implement annex.retry et al

Added annex.retry, annex.retry-delay, and per-remote versions to configure
transfer retries.

This commit was supported by the NSF-funded DataLad project.
This commit is contained in:
Joey Hess 2018-03-29 13:04:07 -04:00
parent 8a03f38931
commit 46d4316954
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
10 changed files with 67 additions and 21 deletions

View file

@ -339,7 +339,7 @@ downloadWith' downloader dummykey u url afile =
checkDiskSpaceToGet dummykey Nothing $ do
tmp <- fromRepo $ gitAnnexTmpObjectLocation dummykey
ok <- Transfer.notifyTransfer Transfer.Download url $
Transfer.download u dummykey afile Transfer.forwardRetry $ \p -> do
Transfer.download u dummykey afile Transfer.stdRetry $ \p -> do
liftIO $ createDirectoryIfMissing True (parentDir tmp)
downloader tmp p
if ok

View file

@ -216,6 +216,8 @@ performExport r ea db ek af contentsha loc = do
sent <- case ek of
AnnexKey k -> ifM (inAnnex k)
( notifyTransfer Upload af $
-- Using noRetry here because interrupted
-- exports cannot be resumed.
upload (uuid r) k af noRetry $ \pm -> do
let rollback = void $
performUnexport r ea db [ek] loc

View file

@ -110,7 +110,7 @@ getKey' key afile = dispatch
either (const False) id <$> Remote.hasKey r key
| otherwise = return True
docopy r witness = getViaTmp (RemoteVerify r) key $ \dest ->
download (Remote.uuid r) key afile forwardRetry
download (Remote.uuid r) key afile stdRetry
(\p -> do
showAction $ "from " ++ Remote.name r
Remote.retrieveKeyFile r key afile dest p

View file

@ -134,7 +134,7 @@ toPerform dest move key afile fastcheck isthere =
Right False -> do
showAction $ "to " ++ Remote.name dest
ok <- notifyTransfer Upload afile $
upload (Remote.uuid dest) key afile forwardRetry $
upload (Remote.uuid dest) key afile stdRetry $
Remote.storeKey dest key afile
if ok
then finish $
@ -199,7 +199,7 @@ fromPerform src move key afile = do
)
where
go = notifyTransfer Download afile $
download (Remote.uuid src) key afile forwardRetry $ \p ->
download (Remote.uuid src) key afile stdRetry $ \p ->
getViaTmp (RemoteVerify src) key $ \t ->
Remote.retrieveKeyFile src key afile t p
dispatch _ False = stop -- failed

View file

@ -51,7 +51,7 @@ start o key = case fromToOptions o of
toPerform :: Key -> AssociatedFile -> Remote -> CommandPerform
toPerform key file remote = go Upload file $
upload (uuid remote) key file forwardRetry $ \p -> do
upload (uuid remote) key file stdRetry $ \p -> do
ok <- Remote.storeKey remote key file p
when ok $
Remote.logStatus remote key InfoPresent
@ -59,7 +59,7 @@ toPerform key file remote = go Upload file $
fromPerform :: Key -> AssociatedFile -> Remote -> CommandPerform
fromPerform key file remote = go Upload file $
download (uuid remote) key file forwardRetry $ \p ->
download (uuid remote) key file stdRetry $ \p ->
getViaTmp (RemoteVerify remote) key $
\t -> Remote.retrieveKeyFile remote key file t p

View file

@ -35,13 +35,13 @@ start = do
where
runner (TransferRequest direction remote key file)
| direction == Upload = notifyTransfer direction file $
upload (Remote.uuid remote) key file forwardRetry $ \p -> do
upload (Remote.uuid remote) key file stdRetry $ \p -> do
ok <- Remote.storeKey remote key file p
when ok $
Remote.logStatus remote key InfoPresent
return ok
| otherwise = notifyTransfer direction file $
download (Remote.uuid remote) key file forwardRetry $ \p ->
download (Remote.uuid remote) key file stdRetry $ \p ->
getViaTmp (RemoteVerify remote) key $ \t -> do
r <- Remote.retrieveKeyFile remote key file t p
-- Make sure we get the current