diff options
author | 2015-05-12 15:50:03 -0400 | |
---|---|---|
committer | 2015-05-12 15:53:38 -0400 | |
commit | 7ca8bf3321d1b62ea4e817e28914ed2fa56afe30 (patch) | |
tree | 2d176cb156c749348d4805af31309a25bdc9f897 /Command | |
parent | b94eafec8c4a7868da753f9b22ca823552e9764c (diff) |
Avoid accumulating transfer failure log files unless the assistant is being used.
Only the assistant uses these, and only the assistant cleans them up, so
make only git annex transferkeys write them,
There is one behavior change from this. If glacier is being used, and a
manual git annex get --from glacier fails because the file isn't available
yet, the assistant will no longer later see that failed transfer file and
retry the get. Hope no-one depended on that old behavior.
Diffstat (limited to 'Command')
-rw-r--r-- | Command/AddUrl.hs | 4 | ||||
-rw-r--r-- | Command/Get.hs | 2 | ||||
-rw-r--r-- | Command/Move.hs | 4 | ||||
-rw-r--r-- | Command/SendKey.hs | 2 | ||||
-rw-r--r-- | Command/TransferKey.hs | 4 | ||||
-rw-r--r-- | Command/TransferKeys.hs | 7 |
6 files changed, 13 insertions, 10 deletions
diff --git a/Command/AddUrl.hs b/Command/AddUrl.hs index 6474f2614..96a966e8d 100644 --- a/Command/AddUrl.hs +++ b/Command/AddUrl.hs @@ -223,7 +223,7 @@ addUrlFileQuvi relaxed quviurl videourl file = do tmp <- fromRepo $ gitAnnexTmpObjectLocation key showOutput ok <- Transfer.notifyTransfer Transfer.Download (Just file) $ - Transfer.download webUUID key (Just file) Transfer.forwardRetry $ const $ do + Transfer.download webUUID key (Just file) Transfer.forwardRetry Transfer.noObserver $ const $ do liftIO $ createDirectoryIfMissing True (parentDir tmp) downloadUrl [videourl] tmp if ok @@ -297,7 +297,7 @@ downloadWith downloader dummykey u url file = ) where runtransfer tmp = Transfer.notifyTransfer Transfer.Download (Just file) $ - Transfer.download u dummykey (Just file) Transfer.forwardRetry $ \p -> do + Transfer.download u dummykey (Just file) Transfer.forwardRetry Transfer.noObserver $ \p -> do liftIO $ createDirectoryIfMissing True (parentDir tmp) downloader tmp p diff --git a/Command/Get.hs b/Command/Get.hs index 380a68097..dcd7e367a 100644 --- a/Command/Get.hs +++ b/Command/Get.hs @@ -90,6 +90,6 @@ getKeyFile' key afile dest = dispatch | Remote.hasKeyCheap r = either (const False) id <$> Remote.hasKey r key | otherwise = return True - docopy r = download (Remote.uuid r) key afile noRetry $ \p -> do + docopy r = download (Remote.uuid r) key afile noRetry noObserver $ \p -> do showAction $ "from " ++ Remote.name r Remote.retrieveKeyFile r key afile dest p diff --git a/Command/Move.hs b/Command/Move.hs index 91f7c8ea7..6867052de 100644 --- a/Command/Move.hs +++ b/Command/Move.hs @@ -95,7 +95,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 noRetry $ + upload (Remote.uuid dest) key afile noRetry noObserver $ Remote.storeKey dest key afile if ok then do @@ -152,7 +152,7 @@ fromPerform src move key afile = ifM (inAnnex key) ) where go = notifyTransfer Download afile $ - download (Remote.uuid src) key afile noRetry $ \p -> do + download (Remote.uuid src) key afile noRetry noObserver $ \p -> do showAction $ "from " ++ Remote.name src getViaTmp key $ \t -> Remote.retrieveKeyFile src key afile t p dispatch _ False = stop -- failed diff --git a/Command/SendKey.hs b/Command/SendKey.hs index 62b4edcba..011785582 100644 --- a/Command/SendKey.hs +++ b/Command/SendKey.hs @@ -44,7 +44,7 @@ fieldTransfer :: Direction -> Key -> (MeterUpdate -> Annex Bool) -> CommandStart fieldTransfer direction key a = do afile <- Fields.getField Fields.associatedFile ok <- maybe (a $ const noop) - (\u -> runner (Transfer direction (toUUID u) key) afile noRetry a) + (\u -> runner (Transfer direction (toUUID u) key) afile noRetry noObserver a) =<< Fields.getField Fields.remoteUUID liftIO $ exitBool ok where diff --git a/Command/TransferKey.hs b/Command/TransferKey.hs index 55d6b95a1..14e788893 100644 --- a/Command/TransferKey.hs +++ b/Command/TransferKey.hs @@ -42,7 +42,7 @@ start to from file key = toPerform :: Remote -> Key -> AssociatedFile -> CommandPerform toPerform remote key file = go Upload file $ - upload (uuid remote) key file forwardRetry $ \p -> do + upload (uuid remote) key file forwardRetry noObserver $ \p -> do ok <- Remote.storeKey remote key file p when ok $ Remote.logStatus remote key InfoPresent @@ -50,7 +50,7 @@ toPerform remote key file = go Upload file $ fromPerform :: Remote -> Key -> AssociatedFile -> CommandPerform fromPerform remote key file = go Upload file $ - download (uuid remote) key file forwardRetry $ \p -> + download (uuid remote) key file forwardRetry noObserver $ \p -> getViaTmp key $ \t -> Remote.retrieveKeyFile remote key file t p go :: Direction -> AssociatedFile -> (NotifyWitness -> Annex Bool) -> CommandPerform diff --git a/Command/TransferKeys.hs b/Command/TransferKeys.hs index b787fe9be..d490d9be4 100644 --- a/Command/TransferKeys.hs +++ b/Command/TransferKeys.hs @@ -36,14 +36,17 @@ 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 forwardRetry observer $ \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 forwardRetry observer $ \p -> getViaTmp key $ \t -> Remote.retrieveKeyFile remote key file t p + + observer False t info = recordFailedTransfer t info + observer True _ _ = noop runRequests :: Handle |