catch whereisKey exception and provide error messages when external programs neglect to

* whereis: If a remote fails to report on urls where a key
  is located, display a warning, rather than giving up and not displaying
  any information.
* When external special remotes fail but neglect to provide an error
  message, say what request failed, which is better than displaying an
  empty error message to the user.

diff --git a/CHANGELOG b/CHANGELOG
index 21971c1d793dab656c0da056d7f4502592306c3e..18a89634325c0de9b53b86e629c1986a6092660a 100644 (file)
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -1,6 +1,12 @@
 git-annex (8.20200227) UNRELEASED; urgency=medium
 
   * Bugfix: Don't ignore --debug when it is followed by -c.
+  * whereis: If a remote fails to report on urls where a key
+    is located, display a warning, rather than giving up and not displaying
+    any information.
+  * When external special remotes fail but neglect to provide an error
+    message, say what request failed, which is better than displaying an
+    empty error message to the user.
 
  -- Joey Hess <id@joeyh.name>  Thu, 27 Feb 2020 00:44:11 -0400
 

diff --git a/Command/Whereis.hs b/Command/Whereis.hs
index 1946cfbdf68815cd63affec6ff7c69b447e35d22..8e0ecb9e8374fb713a7d09d1519aee7acac11e0e 100644 (file)
--- a/Command/Whereis.hs
+++ b/Command/Whereis.hs
@@ -92,7 +92,18 @@ getRemoteUrls key remote
                <$> askremote
                <*> claimedurls
   where
-       askremote = maybe (pure []) (flip id key) (whereisKey remote)
+       askremote = case whereisKey remote of
+               Nothing -> pure []
+               Just w -> tryNonAsync (w key) >>= \case
+                       Right l -> pure l
+                       Left e -> do
+                               warning $ unwords
+                                       [ "unable to query remote"
+                                       , name remote
+                                       , "for urls:"
+                                       , show e
+                                       ]
+                               return []
        claimedurls = do
                us <- map fst 
                        . filter (\(_, d) -> d == OtherDownloader)

diff --git a/Remote/External.hs b/Remote/External.hs
index f8978c2950d39f2b8e5107b0ea3226242e257f63..0dfa449a8acd55d041a2d8bcb0ec7e65dbfc63a1 100644 (file)
--- a/Remote/External.hs
+++ b/Remote/External.hs
@@ -183,7 +183,8 @@ externalSetup _ mu _ c gc = do
                                =<< strictRemoteConfigParser external
                        handleRequest external INITREMOTE Nothing $ \resp -> case resp of
                                INITREMOTE_SUCCESS -> result ()
-                               INITREMOTE_FAILURE errmsg -> Just $ giveup errmsg
+                               INITREMOTE_FAILURE errmsg -> Just $ giveup $
+                                       respErrorMessage "INITREMOTE" errmsg
                                _ -> Nothing
                        -- Any config changes the external made before
                        -- responding to INITREMOTE need to be applied to
@@ -218,7 +219,7 @@ storeKeyM external = fileStorer $ \k f p ->
                        TRANSFER_SUCCESS Upload k' | k == k' -> result True
                        TRANSFER_FAILURE Upload k' errmsg | k == k' ->
                                Just $ do
-                                       warning errmsg
+                                       warning $ respErrorMessage "TRANSFER" errmsg
                                        return (Result False)
                        _ -> Nothing
 
@@ -229,7 +230,8 @@ retrieveKeyFileM external = fileRetriever $ \d k p ->
                        TRANSFER_SUCCESS Download k'
                                | k == k' -> result ()
                        TRANSFER_FAILURE Download k' errmsg
-                               | k == k' -> Just $ giveup errmsg
+                               | k == k' -> Just $ giveup $
+                                       respErrorMessage "TRANSFER" errmsg
                        _ -> Nothing
 
 removeKeyM :: External -> Remover
@@ -240,7 +242,7 @@ removeKeyM external k = safely $
                                | k == k' -> result True
                        REMOVE_FAILURE k' errmsg
                                | k == k' -> Just $ do
-                                       warning errmsg
+                                       warning $ respErrorMessage "REMOVE" errmsg
                                        return (Result False)
                        _ -> Nothing
 
@@ -254,7 +256,8 @@ checkPresentM external k = either giveup id <$> go
                        CHECKPRESENT_FAILURE k'
                                | k' == k -> result $ Right False
                        CHECKPRESENT_UNKNOWN k' errmsg
-                               | k' == k -> result $ Left errmsg
+                               | k' == k -> result $ Left $
+                                       respErrorMessage "CHECKPRESENT" errmsg
                        _ -> Nothing
 
 whereisKeyM :: External -> Key -> Annex [String]
@@ -270,7 +273,7 @@ storeExportM external f k loc p = safely $
                TRANSFER_SUCCESS Upload k' | k == k' -> result True
                TRANSFER_FAILURE Upload k' errmsg | k == k' ->
                        Just $ do
-                               warning errmsg
+                               warning $ respErrorMessage "TRANSFER" errmsg
                                return (Result False)
                UNSUPPORTED_REQUEST -> Just $ do
                        warning "TRANSFEREXPORT not implemented by external special remote"
@@ -286,7 +289,7 @@ retrieveExportM external k loc d p = safely $
                        | k == k' -> result True
                TRANSFER_FAILURE Download k' errmsg
                        | k == k' -> Just $ do
-                               warning errmsg
+                               warning $ respErrorMessage "TRANSFER" errmsg
                                return (Result False)
                UNSUPPORTED_REQUEST -> Just $ do
                        warning "TRANSFEREXPORT not implemented by external special remote"
@@ -304,7 +307,8 @@ checkPresentExportM external k loc = either giveup id <$> go
                CHECKPRESENT_FAILURE k'
                        | k' == k -> result $ Right False
                CHECKPRESENT_UNKNOWN k' errmsg
-                       | k' == k -> result $ Left errmsg
+                       | k' == k -> result $ Left $
+                               respErrorMessage "CHECKPRESENT" errmsg
                UNSUPPORTED_REQUEST -> result $
                        Left "CHECKPRESENTEXPORT not implemented by external special remote"
                _ -> Nothing
@@ -316,7 +320,7 @@ removeExportM external k loc = safely $
                        | k == k' -> result True
                REMOVE_FAILURE k' errmsg
                        | k == k' -> Just $ do
-                               warning errmsg
+                               warning $ respErrorMessage "REMOVE" errmsg
                                return (Result False)
                UNSUPPORTED_REQUEST -> Just $ do
                        warning "REMOVEEXPORT not implemented by external special remote"
@@ -684,13 +688,19 @@ checkPrepared st external = do
                                                setprepared Prepared
                                                return (Result ())
                                        PREPARE_FAILURE errmsg -> Just $ do
-                                               setprepared $ FailedPrepare errmsg
-                                               giveup errmsg
+                                               let errmsg' = respErrorMessage "PREPARE" errmsg
+                                               setprepared $ FailedPrepare errmsg'
+                                               giveup errmsg'
                                        _ -> Nothing
   where
        setprepared status = liftIO $ atomically $ void $
                swapTVar (externalPrepared st) status
 
+respErrorMessage :: String -> String -> String
+respErrorMessage req err
+       | null err = req ++ " failed with no reason given"
+       | otherwise = err
+
 {- Caches the cost in the git config to avoid needing to start up an
  - external special remote every time time just to ask it what its
  - cost is. -}
@@ -743,7 +753,8 @@ checkUrlM external url =
                CHECKURL_CONTENTS sz f -> result $ UrlContents sz $
                        if null f then Nothing else Just $ mkSafeFilePath f
                CHECKURL_MULTI l -> result $ UrlMulti $ map mkmulti l
-               CHECKURL_FAILURE errmsg -> Just $ giveup errmsg
+               CHECKURL_FAILURE errmsg -> Just $ giveup $
+                       respErrorMessage "CHECKURL" errmsg
                UNSUPPORTED_REQUEST -> giveup "CHECKURL not implemented by external special remote"
                _ -> Nothing
   where