summaryrefslogtreecommitdiff
path: root/Remote
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-12-27 17:14:44 -0400
committerGravatar Joey Hess <joey@kitenet.net>2013-12-27 17:14:44 -0400
commit401b71b824f4ac523f8080b3cda432c455b1d1f3 (patch)
treec9464cab880240ccfcb1a05431095e6815278a57 /Remote
parent3cb18402ccdd1c3712b54ac7423675a34add3683 (diff)
better error messages when external special remote exits unexpectedly or is not in PATH
Diffstat (limited to 'Remote')
-rw-r--r--Remote/External.hs43
1 files changed, 27 insertions, 16 deletions
diff --git a/Remote/External.hs b/Remote/External.hs
index 2d777ff7f..b90d3f3fc 100644
--- a/Remote/External.hs
+++ b/Remote/External.hs
@@ -256,17 +256,20 @@ receiveMessage
-> (RemoteRequest -> Maybe (Annex a))
-> (AsyncMessage -> Maybe (Annex a))
-> Annex a
-receiveMessage lck external handleresponse handlerequest handleasync = do
- s <- fromExternal lck external externalReceive $ liftIO . hGetLine
- liftIO $ protocolDebug external False s
- case parseMessage s :: Maybe Response of
- Just resp -> maybe (protocolError True s) id (handleresponse resp)
- Nothing -> case parseMessage s :: Maybe RemoteRequest of
- Just req -> maybe (protocolError True s) id (handlerequest req)
- Nothing -> case parseMessage s :: Maybe AsyncMessage of
- Just msg -> maybe (protocolError True s) id (handleasync msg)
- Nothing -> protocolError False s
+receiveMessage lck external handleresponse handlerequest handleasync =
+ go =<< fromExternal lck external externalReceive
+ (liftIO . catchMaybeIO . hGetLine)
where
+ go Nothing = protocolError False ""
+ go (Just s) = do
+ liftIO $ protocolDebug external False s
+ case parseMessage s :: Maybe Response of
+ Just resp -> maybe (protocolError True s) id (handleresponse resp)
+ Nothing -> case parseMessage s :: Maybe RemoteRequest of
+ Just req -> maybe (protocolError True s) id (handlerequest req)
+ Nothing -> case parseMessage s :: Maybe AsyncMessage of
+ Just msg -> maybe (protocolError True s) id (handleasync msg)
+ Nothing -> protocolError False 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)"
@@ -307,20 +310,28 @@ fromExternal lck external extractor a =
- VERSION, etc. -}
startExternal :: ExternalType -> Annex ExternalState
startExternal externaltype = liftIO $ do
- (Just hin, Just hout, _, pid) <- createProcess $
- (proc (externalRemoteProgram externaltype) [])
- { std_in = CreatePipe
- , std_out = CreatePipe
- , std_err = Inherit
- }
+ (Just hin, Just hout, _, pid) <- createProcess $ (proc cmd [])
+ { std_in = CreatePipe
+ , std_out = CreatePipe
+ , std_err = Inherit
+ }
fileEncoding hin
fileEncoding hout
+ checkearlytermination =<< getProcessExitCode pid
return $ ExternalState
{ externalSend = hin
, externalReceive = hout
, externalPid = pid
, 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 = liftIO $ stop =<< atomically (tryReadTMVar v)