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

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.
This commit is contained in:
Joey Hess 2020-08-14 15:38:31 -04:00
parent 05b2b46a82
commit f241a3cd3d
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
2 changed files with 17 additions and 8 deletions

View file

@ -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 This can be used by an external special remote to let a single process
perform concurrent actions, rather than multiple processes being perform concurrent actions, rather than multiple processes being
started, when that is more efficient. 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 -- Joey Hess <id@joeyh.name> Fri, 14 Aug 2020 14:57:45 -0400

View file

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