better error messages when external special remote exits unexpectedly or is not in PATH
This commit is contained in:
parent
8cfaadf55c
commit
aa97a33dde
1 changed files with 27 additions and 16 deletions
|
@ -256,8 +256,12 @@ receiveMessage
|
||||||
-> (RemoteRequest -> Maybe (Annex a))
|
-> (RemoteRequest -> Maybe (Annex a))
|
||||||
-> (AsyncMessage -> Maybe (Annex a))
|
-> (AsyncMessage -> Maybe (Annex a))
|
||||||
-> Annex a
|
-> Annex a
|
||||||
receiveMessage lck external handleresponse handlerequest handleasync = do
|
receiveMessage lck external handleresponse handlerequest handleasync =
|
||||||
s <- fromExternal lck external externalReceive $ liftIO . hGetLine
|
go =<< fromExternal lck external externalReceive
|
||||||
|
(liftIO . catchMaybeIO . hGetLine)
|
||||||
|
where
|
||||||
|
go Nothing = protocolError False ""
|
||||||
|
go (Just s) = do
|
||||||
liftIO $ protocolDebug external False s
|
liftIO $ protocolDebug external False s
|
||||||
case parseMessage s :: Maybe Response of
|
case parseMessage s :: Maybe Response of
|
||||||
Just resp -> maybe (protocolError True s) id (handleresponse resp)
|
Just resp -> maybe (protocolError True s) id (handleresponse resp)
|
||||||
|
@ -266,7 +270,6 @@ receiveMessage lck external handleresponse handlerequest handleasync = do
|
||||||
Nothing -> case parseMessage s :: Maybe AsyncMessage of
|
Nothing -> case parseMessage s :: Maybe AsyncMessage of
|
||||||
Just msg -> maybe (protocolError True s) id (handleasync msg)
|
Just msg -> maybe (protocolError True s) id (handleasync msg)
|
||||||
Nothing -> protocolError False s
|
Nothing -> protocolError False s
|
||||||
where
|
|
||||||
protocolError parsed s = error $ "external special remote protocol error, unexpectedly received \"" ++ s ++ "\" " ++
|
protocolError parsed s = error $ "external special remote protocol error, unexpectedly received \"" ++ s ++ "\" " ++
|
||||||
if parsed then "(command not allowed at this time)" else "(unable to parse command)"
|
if parsed then "(command not allowed at this time)" else "(unable to parse command)"
|
||||||
|
|
||||||
|
@ -307,20 +310,28 @@ fromExternal lck external extractor a =
|
||||||
- VERSION, etc. -}
|
- VERSION, etc. -}
|
||||||
startExternal :: ExternalType -> Annex ExternalState
|
startExternal :: ExternalType -> Annex ExternalState
|
||||||
startExternal externaltype = liftIO $ do
|
startExternal externaltype = liftIO $ do
|
||||||
(Just hin, Just hout, _, pid) <- createProcess $
|
(Just hin, Just hout, _, pid) <- createProcess $ (proc cmd [])
|
||||||
(proc (externalRemoteProgram externaltype) [])
|
|
||||||
{ std_in = CreatePipe
|
{ std_in = CreatePipe
|
||||||
, std_out = CreatePipe
|
, std_out = CreatePipe
|
||||||
, std_err = Inherit
|
, std_err = Inherit
|
||||||
}
|
}
|
||||||
fileEncoding hin
|
fileEncoding hin
|
||||||
fileEncoding hout
|
fileEncoding hout
|
||||||
|
checkearlytermination =<< getProcessExitCode pid
|
||||||
return $ ExternalState
|
return $ ExternalState
|
||||||
{ externalSend = hin
|
{ externalSend = hin
|
||||||
, externalReceive = hout
|
, externalReceive = hout
|
||||||
, externalPid = pid
|
, externalPid = pid
|
||||||
, externalPrepared = False
|
, externalPrepared = False
|
||||||
}
|
}
|
||||||
|
where
|
||||||
|
cmd = externalRemoteProgram externaltype
|
||||||
|
|
||||||
|
checkearlytermination Nothing = noop
|
||||||
|
checkearlytermination (Just exitcode) = ifM (inPath cmd)
|
||||||
|
( error $ unwords [ "failed to run", cmd, "(" ++ show exitcode ++ ")" ]
|
||||||
|
, error $ cmd ++ " is not installed in PATH"
|
||||||
|
)
|
||||||
|
|
||||||
stopExternal :: External -> Annex ()
|
stopExternal :: External -> Annex ()
|
||||||
stopExternal external = liftIO $ stop =<< atomically (tryReadTMVar v)
|
stopExternal external = liftIO $ stop =<< atomically (tryReadTMVar v)
|
||||||
|
|
Loading…
Add table
Reference in a new issue