don't send PREPARE before INITREMOTE

That complicated special remote programs, because they had to avoid making
PREPARE fail if some configuration is missing, because the remote might not
be initialized yet. Instead, complicate git-annex slightly by only sending
PREPARE immediately before some other request other than INITREMOTE (or
PREPARE of course).
This commit is contained in:
Joey Hess 2013-12-27 02:49:10 -04:00
parent 5b7c38c90a
commit 3289155e28
3 changed files with 31 additions and 14 deletions

View file

@ -169,6 +169,8 @@ handleRequest external req mp responsehandler =
handleRequest' :: ExternalLock -> External -> Request -> Maybe MeterUpdate -> (Response -> Maybe (Annex a)) -> Annex a
handleRequest' lck external req mp responsehandler = do
when (needsPREPARE req) $
checkPrepared lck external
sendMessage lck external req
loop
where
@ -230,15 +232,13 @@ fromExternal lck external extractor a =
void $ liftIO $ atomically $ swapTMVar v st
{- Handle initial protocol startup; check the VERSION
- the remote sends, and send it the PREPARE request. -}
- the remote sends. -}
receiveMessage lck external
(const Nothing)
(checkVersion lck external)
(const Nothing)
handleRequest' lck external PREPARE Nothing $ \resp ->
case resp of
PREPARE_SUCCESS -> Just $ run st
_ -> Nothing
run st
run st = a $ extractor st
v = externalState external
@ -259,6 +259,7 @@ startExternal externaltype = liftIO $ do
{ externalSend = hin
, externalReceive = hout
, externalPid = pid
, externalPrepared = False
}
stopExternal :: External -> Annex ()
@ -282,6 +283,15 @@ checkVersion lck external (VERSION v) = Just $
else sendMessage lck external (ERROR "unsupported VERSION")
checkVersion _ _ _ = Nothing
checkPrepared :: ExternalLock -> External -> Annex ()
checkPrepared lck external =
fromExternal lck external externalPrepared $ \prepared ->
unless prepared $
handleRequest' lck external PREPARE Nothing $ \resp ->
case resp of
PREPARE_SUCCESS -> Just noop
_ -> Nothing
{- 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. -}

View file

@ -18,6 +18,7 @@ module Remote.External.Types (
Sendable(..),
Receivable(..),
Request(..),
needsPREPARE,
Response(..),
RemoteRequest(..),
RemoteResponse(..),
@ -60,6 +61,7 @@ data ExternalState = ExternalState
{ externalSend :: Handle
, externalReceive :: Handle
, externalPid :: ProcessHandle
, externalPrepared :: Bool
}
-- Constructor is not exported, and only created by newExternal.
@ -98,6 +100,12 @@ data Request
| REMOVE Key
deriving (Show)
-- Does PREPARE need to have been sent before this request?
needsPREPARE :: Request -> Bool
needsPREPARE PREPARE = False
needsPREPARE INITREMOTE = False
needsPREPARE _ = True
instance Sendable Request where
formatMessage PREPARE = ["PREPARE"]
formatMessage INITREMOTE = ["INITREMOTE"]