From df07ccf404bf6a950fe0a0a31f315486c510a2f0 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 23 Sep 2012 13:27:13 -0400 Subject: [PATCH] make the assistant retry failed transfers 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). --- Command/Get.hs | 2 +- Command/Move.hs | 4 ++-- Command/SendKey.hs | 4 ++-- Command/TransferKey.hs | 4 ++-- Logs/Transfer.hs | 36 ++++++++++++++++++++++++++++-------- Remote/Git.hs | 4 ++-- 6 files changed, 37 insertions(+), 17 deletions(-) diff --git a/Command/Get.hs b/Command/Get.hs index 18153ce888..ab0e60b41f 100644 --- a/Command/Get.hs +++ b/Command/Get.hs @@ -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 diff --git a/Command/Move.hs b/Command/Move.hs index 7955cecd3c..36242f45c1 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -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 diff --git a/Command/SendKey.hs b/Command/SendKey.hs index e5d4c7e6e0..2aae1ab900 100644 --- a/Command/SendKey.hs +++ b/Command/SendKey.hs @@ -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 diff --git a/Command/TransferKey.hs b/Command/TransferKey.hs index 793dbeb561..a308e01754 100644 --- a/Command/TransferKey.hs +++ b/Command/TransferKey.hs @@ -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 diff --git a/Logs/Transfer.hs b/Logs/Transfer.hs index 7188143d68..016571d23a 100644 --- a/Logs/Transfer.hs +++ b/Logs/Transfer.hs @@ -74,11 +74,21 @@ percentComplete :: Transfer -> TransferInfo -> Maybe Percentage percentComplete (Transfer { transferKey = key }) info = percentage <$> keySize key <*> Just (fromMaybe 0 $ bytesComplete info) -upload :: UUID -> Key -> AssociatedFile -> (MeterUpdate -> Annex Bool) -> Annex Bool -upload u key file a = runTransfer (Transfer Upload u key) file a +type RetryDecider = TransferInfo -> TransferInfo -> Bool -download :: UUID -> Key -> AssociatedFile -> Annex Bool -> Annex Bool -download u key file a = runTransfer (Transfer Download u key) file (const a) +noRetry :: RetryDecider +noRetry _ _ = False + +{- Retries a transfer when it fails, as long as the failed transfer managed + - to send some data. -} +forwardRetry :: RetryDecider +forwardRetry old new = bytesComplete old < bytesComplete new + +upload :: UUID -> Key -> AssociatedFile -> RetryDecider -> (MeterUpdate -> Annex Bool) -> Annex Bool +upload u key = runTransfer (Transfer Upload u key) + +download :: UUID -> Key -> AssociatedFile -> RetryDecider -> Annex Bool -> Annex Bool +download u key file shouldretry a = runTransfer (Transfer Download u key) file shouldretry (const a) {- Runs a transfer action. Creates and locks the lock file while the - action is running, and stores info in the transfer information @@ -87,12 +97,12 @@ download u key file a = runTransfer (Transfer Download u key) file (const a) - If the transfer action returns False, the transfer info is - left in the failedTransferDir. -} -runTransfer :: Transfer -> Maybe FilePath -> (MeterUpdate -> Annex Bool) -> Annex Bool -runTransfer t file a = do +runTransfer :: Transfer -> Maybe FilePath -> RetryDecider -> (MeterUpdate -> Annex Bool) -> Annex Bool +runTransfer t file shouldretry a = do info <- liftIO $ startTransferInfo file (meter, tfile) <- mkProgressUpdater t info mode <- annexFileMode - ok <- bracketIO (prep tfile mode info) (cleanup tfile) (a meter) + ok <- retry tfile info $ bracketIO (prep tfile mode info) (cleanup tfile) (a meter) unless ok $ failed info return ok where @@ -113,7 +123,17 @@ runTransfer t file a = do failedtfile <- fromRepo $ failedTransferFile t createAnnexDirectory $ takeDirectory failedtfile liftIO $ writeTransferInfoFile info failedtfile - + retry tfile oldinfo run = do + ok <- run + if ok + then return ok + else do + v <- liftIO $ readTransferInfoFile Nothing tfile + case v of + Nothing -> return ok + Just newinfo -> if shouldretry oldinfo newinfo + then retry tfile newinfo run + else return ok {- Generates a callback that can be called as transfer progresses to update - the transfer info file. Also returns the file it'll be updating. -} diff --git a/Remote/Git.hs b/Remote/Git.hs index a1c5b24b42..e7b1ca0e85 100644 --- a/Remote/Git.hs +++ b/Remote/Git.hs @@ -247,7 +247,7 @@ copyFromRemote r key file dest liftIO $ onLocal r $ do ensureInitialized loc <- inRepo $ gitAnnexLocation key - upload u key file $ + upload u key file noRetry $ rsyncOrCopyFile params loc dest | Git.repoIsSsh r = feedprogressback $ \feeder -> rsyncHelper (Just feeder) @@ -317,7 +317,7 @@ copyToRemote r key file p ( return False , do ensureInitialized - download u key file $ + download u key file noRetry $ Annex.Content.saveState True `after` Annex.Content.getViaTmp key (\d -> rsyncOrCopyFile params keysrc d p)