Display warning when external special remote does not start up properly, or is not...

I'm sure this used to work, but somewhere along the line something or
things (getCost and getAvailability I think, probably others)
started catching the exception and not displaying it. So, show warnings.

diff --git a/CHANGELOG b/CHANGELOG
index 5c1b4aa3c34dfe8eb457b32cb1f284d9edb0dae4..009b67c7f1769151cf83a36074fa7f96b531f28b 100644 (file)
--- a/CHANGELOG
+++ b/CHANGELOG
@@ -4,6 +4,8 @@ git-annex (8.20200815) UNRELEASED; urgency=medium
     This can be used by an external special remote to let a single process
     perform concurrent actions, rather than multiple processes being
     started, when that is more efficient.
+  * Display warning when external special remote does not start up
+    properly, or is not usable.
 
  -- Joey Hess <id@joeyh.name>  Fri, 14 Aug 2020 14:57:45 -0400
 

diff --git a/Remote/External.hs b/Remote/External.hs
index 6b687d063b2385a8a14f4ea9cccfe07dd5f4d28a..41d6c351f76451ca26151bf389c0c8d9e38895d4 100644 (file)
--- a/Remote/External.hs
+++ b/Remote/External.hs
@@ -565,10 +565,12 @@ receiveMessage st external handleresponse handlerequest handleexceptional =
                        Nothing -> case parseMessage s :: Maybe ExceptionalMessage of
                                Just msg -> maybe (protocolError True s) id (handleexceptional msg)
                                Nothing -> protocolError False s
-       protocolError parsed s = giveup $ "external special remote protocol error, unexpectedly received \"" ++ s ++ "\" " ++
-               if parsed
-                       then "(command not allowed at this time)"
-                       else "(unable to parse command)"
+       protocolError parsed s = do
+               warning $ "external special remote protocol error, unexpectedly received \"" ++ s ++ "\" " ++
+                       if parsed
+                               then "(command not allowed at this time)"
+                               else "(unable to parse command)"
+               giveup "unable to use special remote due to protocol error"
 
 {- While the action is running, the ExternalState provided to it will not
  - be available to any other calls.
@@ -639,17 +641,18 @@ startExternal' external = do
                writeTVar (externalLastPid external) n
                return n
        AddonProcess.startExternalAddonProcess basecmd pid >>= \case
-               Left (AddonProcess.ProgramFailure err) -> giveup err
+               Left (AddonProcess.ProgramFailure err) -> do
+                       unusable err
                Left (AddonProcess.ProgramNotInstalled err) ->
                        case (lookupName (unparsedRemoteConfig (externalDefaultConfig external)), remoteAnnexReadOnly <$> externalGitConfig external) of
-                               (Just rname, Just True) -> giveup $ unlines
+                               (Just rname, Just True) -> unusable $ unlines
                                        [ err
                                        , "This remote has annex-readonly=true, and previous versions of"
                                        , "git-annex would tried to download from it without"
                                        , "installing " ++ basecmd ++ ". If you want that, you need to set:"
                                        , "git config remote." ++ rname ++ ".annex-externaltype readonly"
                                        ]
-                               _ -> giveup err
+                               _ -> unusable err
                Right p -> do
                        cv <- liftIO $ newTMVarIO $ externalDefaultConfig external
                        ccv <- liftIO $ newTMVarIO id
@@ -685,11 +688,15 @@ startExternal' external = do
                        (const Nothing)
                case filter (`notElem` fromExtensionList supportedExtensionList) (fromExtensionList exwanted) of
                        [] -> return exwanted
-                       exrest -> giveup $ unwords $
+                       exrest -> unusable $ unwords $
                                [ basecmd
                                , "requested extensions that this version of git-annex does not support:"
                                ] ++ exrest
 
+       unusable msg = do
+               warning msg
+               giveup ("unable to use external special remote " ++ basecmd)
+
 stopExternal :: External -> Annex ()
 stopExternal external = liftIO $ do
        l <- atomically $ swapTVar (externalState external) []