diff options
Diffstat (limited to 'Remote')
| -rw-r--r-- | Remote/External.hs | 20 | ||||
| -rw-r--r-- | Remote/External/Types.hs | 8 |
2 files changed, 23 insertions, 5 deletions
diff --git a/Remote/External.hs b/Remote/External.hs index 1cf199e99..5a09d1de0 100644 --- a/Remote/External.hs +++ b/Remote/External.hs @@ -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. -} diff --git a/Remote/External/Types.hs b/Remote/External/Types.hs index 873c5c438..4000f3f49 100644 --- a/Remote/External/Types.hs +++ b/Remote/External/Types.hs @@ -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"] |