make --debug show transcript of special remote protocol messages
This commit is contained in:
parent
526a7bb2b4
commit
5d8ff64dc1
2 changed files with 16 additions and 1 deletions
|
@ -25,6 +25,7 @@ import Annex.Exception
|
|||
|
||||
import Control.Concurrent.STM
|
||||
import System.Process (std_in, std_out, std_err)
|
||||
import System.Log.Logger (debugM)
|
||||
import qualified Data.Map as M
|
||||
|
||||
remote :: RemoteType
|
||||
|
@ -194,7 +195,11 @@ handleRequest' lck external req mp responsehandler = do
|
|||
sendMessage :: Sendable m => ExternalLock -> External -> m -> Annex ()
|
||||
sendMessage lck external m =
|
||||
fromExternal lck external externalSend $ \h ->
|
||||
liftIO $ hPutStrLn h $ unwords $ formatMessage m
|
||||
liftIO $ do
|
||||
protocolDebug external True line
|
||||
hPutStrLn h line
|
||||
where
|
||||
line = unwords $ formatMessage m
|
||||
|
||||
{- Waits for a message from the external remote, and passes it to the
|
||||
- apppropriate handler.
|
||||
|
@ -209,6 +214,7 @@ receiveMessage
|
|||
-> 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 s) id (handleresponse resp)
|
||||
Nothing -> case parseMessage s :: Maybe RemoteRequest of
|
||||
|
@ -219,6 +225,13 @@ receiveMessage lck external handleresponse handlerequest handleasync = do
|
|||
where
|
||||
protocolError s = error $ "external special remote protocol error, unexpectedly received \"" ++ s ++ "\""
|
||||
|
||||
protocolDebug :: External -> Bool -> String -> IO ()
|
||||
protocolDebug external sendto line = debugM "external" $ unwords
|
||||
[ externalRemoteProgram (externalType external)
|
||||
, if sendto then "<--" else "-->"
|
||||
, line
|
||||
]
|
||||
|
||||
{- Starts up the external remote if it's not yet running,
|
||||
- and passes a value extracted from its state to an action.
|
||||
-}
|
||||
|
|
|
@ -14,6 +14,8 @@ It's not hard!
|
|||
* Install it in PATH.
|
||||
* When the user runs `git annex initremote foo type=external externaltype=$bar`,
|
||||
it will use your program.
|
||||
* If things don't seem to work, pass `--debug` and you'll see, amoung other
|
||||
things, a transcript of git-annex's communication with your program.
|
||||
* If you build a new special remote, please add it to the list
|
||||
of [[special_remotes]].
|
||||
|
||||
|
|
Loading…
Reference in a new issue