diff --git a/CmdLine/GitRemoteTorAnnex.hs b/CmdLine/GitRemoteTorAnnex.hs index 8a87797559..04a1466ffb 100644 --- a/CmdLine/GitRemoteTorAnnex.hs +++ b/CmdLine/GitRemoteTorAnnex.hs @@ -57,6 +57,6 @@ connectService address port service = do myuuid <- getUUID g <- Annex.gitRepo conn <- liftIO $ connectPeer g (TorAnnex address port) - liftIO $ runNetProto conn $ auth myuuid authtoken >>= \case + liftIO $ runNetProto conn $ auth myuuid authtoken noop >>= \case Just _theiruuid -> connect service stdin stdout Nothing -> giveup $ "authentication failed, perhaps you need to set " ++ p2pAuthTokenEnv diff --git a/Command/P2P.hs b/Command/P2P.hs index 65a2a67da6..4a41f966f9 100644 --- a/Command/P2P.hs +++ b/Command/P2P.hs @@ -309,7 +309,8 @@ setupLink remotename (P2PAddressAuth addr authtoken) = do Left e -> return $ ConnectionError $ "Unable to connect with peer. Please check that the peer is connected to the network, and try again. (" ++ show e ++ ")" Right conn -> do u <- getUUID - go =<< liftIO (runNetProto conn $ P2P.auth u authtoken) + let proto = P2P.auth u authtoken noop + go =<< liftIO (runNetProto conn proto) where go (Right (Just theiruuid)) = do ok <- inRepo $ Git.Command.runBool diff --git a/Command/P2PStdIO.hs b/Command/P2PStdIO.hs index cb7e54f28f..38a3eb0cf0 100644 --- a/Command/P2PStdIO.hs +++ b/Command/P2PStdIO.hs @@ -35,6 +35,7 @@ start theiruuid = do let server = do P2P.net $ P2P.sendMessage (P2P.AUTH_SUCCESS myuuid) P2P.serveAuthed servermode myuuid - runFullProto (Serving theiruuid Nothing) conn server >>= \case + runst <- liftIO $ mkRunState $ Serving theiruuid Nothing + runFullProto runst conn server >>= \case Right () -> next $ next $ return True Left e -> giveup e diff --git a/P2P/Annex.hs b/P2P/Annex.hs index 9971762f59..1f32149570 100644 --- a/P2P/Annex.hs +++ b/P2P/Annex.hs @@ -1,6 +1,6 @@ {- P2P protocol, Annex implementation - - - Copyright 2016 Joey Hess + - Copyright 2016-2018 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -8,7 +8,8 @@ {-# LANGUAGE RankNTypes, FlexibleContexts #-} module P2P.Annex - ( RunMode(..) + ( RunState(..) + , mkRunState , P2PConnection(..) , runFullProto ) where @@ -24,22 +25,28 @@ import Types.NumCopies import Utility.Metered import Control.Monad.Free +import Control.Concurrent.STM -data RunMode - = Serving UUID (Maybe ChangedRefsHandle) - | Client +data RunState + = Serving UUID (Maybe ChangedRefsHandle) (TVar ProtocolVersion) + | Client (TVar ProtocolVersion) + +mkRunState :: (TVar ProtocolVersion -> RunState) -> IO RunState +mkRunState mk = do + tvar <- newTVarIO defaultProtocolVersion + return (mk tvar) -- Full interpreter for Proto, that can receive and send objects. -runFullProto :: RunMode -> P2PConnection -> Proto a -> Annex (Either String a) -runFullProto runmode conn = go +runFullProto :: RunState -> P2PConnection -> Proto a -> Annex (Either String a) +runFullProto runst conn = go where go :: RunProto Annex go (Pure v) = return (Right v) go (Free (Net n)) = runNet conn go n - go (Free (Local l)) = runLocal runmode go l + go (Free (Local l)) = runLocal runst go l -runLocal :: RunMode -> RunProto Annex -> LocalF (Proto a) -> Annex (Either String a) -runLocal runmode runner a = case a of +runLocal :: RunState -> RunProto Annex -> LocalF (Proto a) -> Annex (Either String a) +runLocal runst runner a = case a of TmpContentSize k next -> do tmp <- fromRepo $ gitAnnexTmpObjectLocation k size <- liftIO $ catchDefaultIO 0 $ getFileSize tmp @@ -113,21 +120,26 @@ runLocal runmode runner a = case a of protoaction False next Right _ -> runner next - WaitRefChange next -> case runmode of - Serving _ (Just h) -> do + WaitRefChange next -> case runst of + Serving _ (Just h) _ -> do v <- tryNonAsync $ liftIO $ waitChangedRefs h case v of Left e -> return (Left (show e)) Right changedrefs -> runner (next changedrefs) _ -> return $ Left "change notification not available" + SetProtocolVersion v next -> do + liftIO $ atomically $ writeTVar versiontvar v + runner next + GetProtocolVersion next -> + liftIO (readTVarIO versiontvar) >>= runner . next where - transfer mk k af ta = case runmode of + transfer mk k af ta = case runst of -- Update transfer logs when serving. - Serving theiruuid _ -> + Serving theiruuid _ _ -> mk theiruuid k af noRetry ta noNotification -- Transfer logs are updated higher in the stack when -- a client. - Client -> ta nullMeterUpdate + Client _ -> ta nullMeterUpdate storefile dest (Offset o) (Len l) getb p = do let p' = offsetMeterUpdate p (toBytesProcessed o) @@ -152,3 +164,6 @@ runLocal runmode runner a = case a of liftIO $ hSeek h AbsoluteSeek o b <- liftIO $ hGetContentsMetered h p' runner (sender b) + versiontvar = case runst of + Serving _ _ tv -> tv + Client tv -> tv diff --git a/P2P/IO.hs b/P2P/IO.hs index 8b532c7f4e..d1474f47b6 100644 --- a/P2P/IO.hs +++ b/P2P/IO.hs @@ -152,11 +152,8 @@ runNet conn runner f = case f of Right (Just l) -> case parseMessage l of Just m -> do liftIO $ debugMessage "P2P <" m - runner (next m) - Nothing -> runner $ do - let e = ERROR $ "protocol parse error: " ++ show l - net $ sendMessage e - next e + runner (next (Just m)) + Nothing -> runner (next Nothing) SendBytes len b p next -> do v <- liftIO $ tryNonAsync $ do ok <- sendExactly len b (connOhdl conn) p diff --git a/P2P/Protocol.hs b/P2P/Protocol.hs index 4acbaadef8..999e5aeb03 100644 --- a/P2P/Protocol.hs +++ b/P2P/Protocol.hs @@ -2,7 +2,7 @@ - - See doc/design/p2p_protocol.mdwn - - - Copyright 2016 Joey Hess + - Copyright 2016-2018 Joey Hess - - Licensed under the GNU GPL version 3 or higher. -} @@ -41,6 +41,15 @@ newtype Offset = Offset Integer newtype Len = Len Integer deriving (Show) +newtype ProtocolVersion = ProtocolVersion Integer + deriving (Show, Eq, Ord) + +defaultProtocolVersion :: ProtocolVersion +defaultProtocolVersion = ProtocolVersion 0 + +maxProtocolVersion :: ProtocolVersion +maxProtocolVersion = ProtocolVersion 1 + -- | Service as used by the connect message in gitremote-helpers(1) data Service = UploadPack | ReceivePack deriving (Show) @@ -51,6 +60,7 @@ data Message = AUTH UUID AuthToken -- uuid of the peer that is authenticating | AUTH_SUCCESS UUID -- uuid of the remote peer | AUTH_FAILURE + | VERSION ProtocolVersion | CONNECT Service | CONNECTDONE ExitCode | NOTIFYCHANGE @@ -73,6 +83,7 @@ instance Proto.Sendable Message where formatMessage (AUTH uuid authtoken) = ["AUTH", Proto.serialize uuid, Proto.serialize authtoken] formatMessage (AUTH_SUCCESS uuid) = ["AUTH-SUCCESS", Proto.serialize uuid] formatMessage AUTH_FAILURE = ["AUTH-FAILURE"] + formatMessage (VERSION v) = ["VERSION", Proto.serialize v] formatMessage (CONNECT service) = ["CONNECT", Proto.serialize service] formatMessage (CONNECTDONE exitcode) = ["CONNECTDONE", Proto.serialize exitcode] formatMessage NOTIFYCHANGE = ["NOTIFYCHANGE"] @@ -94,6 +105,7 @@ instance Proto.Receivable Message where parseCommand "AUTH" = Proto.parse2 AUTH parseCommand "AUTH-SUCCESS" = Proto.parse1 AUTH_SUCCESS parseCommand "AUTH-FAILURE" = Proto.parse0 AUTH_FAILURE + parseCommand "VERSION" = Proto.parse1 VERSION parseCommand "CONNECT" = Proto.parse1 CONNECT parseCommand "CONNECTDONE" = Proto.parse1 CONNECTDONE parseCommand "NOTIFYCHANGE" = Proto.parse0 NOTIFYCHANGE @@ -112,6 +124,10 @@ instance Proto.Receivable Message where parseCommand "ERROR" = Proto.parse1 ERROR parseCommand _ = Proto.parseFail +instance Proto.Serializable ProtocolVersion where + serialize (ProtocolVersion n) = show n + deserialize = ProtocolVersion <$$> readish + instance Proto.Serializable Offset where serialize (Offset n) = show n deserialize = Offset <$$> readish @@ -175,7 +191,7 @@ local = hoistFree Local data NetF c = SendMessage Message c - | ReceiveMessage (Message -> c) + | ReceiveMessage (Maybe Message -> c) | SendBytes Len L.ByteString MeterUpdate c -- ^ Sends exactly Len bytes of data. (Any more or less will -- confuse the receiver.) @@ -239,6 +255,9 @@ data LocalF c -- present, runs the protocol action with False. | WaitRefChange (ChangedRefs -> c) -- ^ Waits for one or more git refs to change and returns them. + | SetProtocolVersion ProtocolVersion c + --- ^ Called when a new protocol version has been negotiated. + | GetProtocolVersion (ProtocolVersion -> c) deriving (Functor) type Local = Free LocalF @@ -247,21 +266,33 @@ type Local = Free LocalF $(makeFree ''NetF) $(makeFree ''LocalF) -auth :: UUID -> AuthToken -> Proto (Maybe UUID) -auth myuuid t = do +auth :: UUID -> AuthToken -> Proto () -> Proto (Maybe UUID) +auth myuuid t a = do net $ sendMessage (AUTH myuuid t) - postAuth + postAuth a -postAuth :: Proto (Maybe UUID) -postAuth = do +postAuth :: Proto () -> Proto (Maybe UUID) +postAuth a = do r <- net receiveMessage case r of - AUTH_SUCCESS theiruuid -> return $ Just theiruuid - AUTH_FAILURE -> return Nothing + Just (AUTH_SUCCESS theiruuid) -> do + a + return $ Just theiruuid + Just AUTH_FAILURE -> return Nothing _ -> do net $ sendMessage (ERROR "auth failed") return Nothing +negotiateProtocolVersion :: ProtocolVersion -> Proto () +negotiateProtocolVersion preferredversion = do + net $ sendMessage (VERSION preferredversion) + r <- net receiveMessage + case r of + Just (VERSION v) -> local $ setProtocolVersion v + -- Old server doesn't know about the VERSION command. + Just (ERROR _) -> return () + _ -> net $ sendMessage (ERROR "expected VERSION") + checkPresent :: Key -> Proto Bool checkPresent key = do net $ sendMessage (CHECKPRESENT key) @@ -303,10 +334,10 @@ put key af p = do net $ sendMessage (PUT af key) r <- net receiveMessage case r of - PUT_FROM offset -> sendContent key af offset p - ALREADY_HAVE -> return True + Just (PUT_FROM offset) -> sendContent key af offset p + Just ALREADY_HAVE -> return True _ -> do - net $ sendMessage (ERROR "expected PUT_FROM") + net $ sendMessage (ERROR "expected PUT_FROM or ALREADY_HAVE") return False data ServerHandler a @@ -317,13 +348,19 @@ data ServerHandler a -- Server loop, getting messages from the client and handling them serverLoop :: (Message -> Proto (ServerHandler a)) -> Proto (Maybe a) serverLoop a = do - cmd <- net receiveMessage - case cmd of + mcmd <- net receiveMessage + case mcmd of -- When the client sends ERROR to the server, the server -- gives up, since it's not clear what state the client -- is in, and so not possible to recover. - ERROR _ -> return Nothing - _ -> do + Just (ERROR _) -> return Nothing + -- When the client sends an unparseable message, the server + -- responds with an error message, and loops. This allows + -- expanding the protocol with new messages. + Nothing -> do + net $ sendMessage (ERROR "unknown command") + serverLoop a + Just cmd -> do v <- a cmd case v of ServerGot r -> return (Just r) @@ -364,13 +401,18 @@ serveAuthed :: ServerMode -> UUID -> Proto () serveAuthed servermode myuuid = void $ serverLoop handler where readonlyerror = net $ sendMessage (ERROR "this repository is read-only; write access denied") + handler (VERSION theirversion) = do + let v = min theirversion maxProtocolVersion + local $ setProtocolVersion v + net $ sendMessage (VERSION v) + return ServerContinue handler (LOCKCONTENT key) = do local $ tryLockContent key $ \locked -> do sendSuccess locked when locked $ do r' <- net receiveMessage case r' of - UNLOCKCONTENT -> return () + Just UNLOCKCONTENT -> return () _ -> net $ sendMessage (ERROR "expected UNLOCKCONTENT") return ServerContinue handler (CHECKPRESENT key) = do @@ -443,7 +485,7 @@ receiveContent p sizer storer mkmsg = do net $ sendMessage (mkmsg offset) r <- net receiveMessage case r of - DATA len -> do + Just (DATA len) -> do ok <- local $ storer offset len (net (receiveBytes len p')) sendSuccess ok @@ -456,8 +498,8 @@ checkSuccess :: Proto Bool checkSuccess = do ack <- net receiveMessage case ack of - SUCCESS -> return True - FAILURE -> return False + Just SUCCESS -> return True + Just FAILURE -> return False _ -> do net $ sendMessage (ERROR "expected SUCCESS or FAILURE") return False @@ -471,7 +513,7 @@ notifyChange = do net $ sendMessage NOTIFYCHANGE ack <- net receiveMessage case ack of - CHANGED rs -> return (Just rs) + Just (CHANGED rs) -> return (Just rs) _ -> do net $ sendMessage (ERROR "expected CHANGED") return Nothing @@ -491,8 +533,8 @@ relayFromPeer :: Net RelayData relayFromPeer = do r <- receiveMessage case r of - CONNECTDONE exitcode -> return $ RelayDone exitcode - DATA len -> RelayFromPeer <$> receiveBytes len nullMeterUpdate + Just (CONNECTDONE exitcode) -> return $ RelayDone exitcode + Just (DATA len) -> RelayFromPeer <$> receiveBytes len nullMeterUpdate _ -> do sendMessage $ ERROR "expected DATA or CONNECTDONE" return $ RelayDone $ ExitFailure 1 diff --git a/Remote/Helper/Ssh.hs b/Remote/Helper/Ssh.hs index 60a6779d83..649e45dd4a 100644 --- a/Remote/Helper/Ssh.hs +++ b/Remote/Helper/Ssh.hs @@ -186,11 +186,12 @@ contentLockedMarker :: String contentLockedMarker = "OK" -- A connection over ssh to git-annex shell speaking the P2P protocol. -type P2PSshConnection = P2P.ClosableConnection (P2P.P2PConnection, ProcessHandle) +type P2PSshConnection = P2P.ClosableConnection + (P2P.RunState, P2P.P2PConnection, ProcessHandle) closeP2PSshConnection :: P2PSshConnection -> IO P2PSshConnection closeP2PSshConnection P2P.ClosedConnection = return P2P.ClosedConnection -closeP2PSshConnection (P2P.OpenConnection (conn, pid)) = do +closeP2PSshConnection (P2P.OpenConnection (_st, conn, pid)) = do P2P.closeConnection conn void $ waitForProcess pid return P2P.ClosedConnection @@ -244,30 +245,34 @@ openP2PSshConnection r connpool = do return Nothing Just (cmd, params) -> start cmd params where - start cmd params = liftIO $ withNullHandle $ \nullh -> do + start cmd params = do -- stderr is discarded because old versions of git-annex -- shell always error - (Just from, Just to, Nothing, pid) <- createProcess $ - (proc cmd (toCommand params)) - { std_in = CreatePipe - , std_out = CreatePipe - , std_err = UseHandle nullh - } + (Just from, Just to, Nothing, pid) <- liftIO $ + withNullHandle $ \nullh -> createProcess $ + (proc cmd (toCommand params)) + { std_in = CreatePipe + , std_out = CreatePipe + , std_err = UseHandle nullh + } let conn = P2P.P2PConnection { P2P.connRepo = repo r , P2P.connCheckAuth = const False , P2P.connIhdl = to , P2P.connOhdl = from } - let c = P2P.OpenConnection (conn, pid) + runst <- liftIO $ P2P.mkRunState P2P.Client + let c = P2P.OpenConnection (runst, conn, pid) -- When the connection is successful, the remote -- will send an AUTH_SUCCESS with its uuid. - tryNonAsync (P2P.runNetProto conn $ P2P.postAuth) >>= \case + let proto = P2P.postAuth $ + P2P.negotiateProtocolVersion P2P.maxProtocolVersion + tryNonAsync (P2P.runFullProto runst conn proto) >>= \case Right (Right (Just theiruuid)) | theiruuid == uuid r -> return $ Just c _ -> do - void $ closeP2PSshConnection c - rememberunsupported + void $ liftIO $ closeP2PSshConnection c + liftIO rememberunsupported return Nothing rememberunsupported = atomically $ modifyTVar' connpool $ @@ -292,8 +297,8 @@ runProto r connpool fallback proto = Just <$> runProtoConn :: P2P.Proto a -> P2PSshConnection -> Annex (P2PSshConnection, Maybe a) runProtoConn _ P2P.ClosedConnection = return (P2P.ClosedConnection, Nothing) -runProtoConn a conn@(P2P.OpenConnection (c, _pid)) = - P2P.runFullProto P2P.Client c a >>= \case +runProtoConn a conn@(P2P.OpenConnection (runst, c, _pid)) = do + P2P.runFullProto runst c a >>= \case Right r -> return (conn, Just r) -- When runFullProto fails, the connection is no longer -- usable, so close it. @@ -302,8 +307,8 @@ runProtoConn a conn@(P2P.OpenConnection (c, _pid)) = conn' <- liftIO $ closeP2PSshConnection conn return (conn', Nothing) --- Allocates a P2P ssh connection, and runs the action with it, --- returning the connection to the pool. +-- Allocates a P2P ssh connection from the pool, and runs the action with it, +-- returning the connection to the pool once the action is done. -- -- If the remote does not support the P2P protocol, runs the fallback -- action instead. diff --git a/Remote/P2P.hs b/Remote/P2P.hs index 95c7f6ede5..ec2f3c4725 100644 --- a/Remote/P2P.hs +++ b/Remote/P2P.hs @@ -77,7 +77,7 @@ chainGen addr r u c gc = do return (Just this) -- | A connection to the peer, which can be closed. -type Connection = ClosableConnection P2PConnection +type Connection = ClosableConnection (RunState, P2PConnection) type ConnectionPool = TVar [Connection] @@ -90,8 +90,8 @@ runProto u addr connpool a = withConnection u addr connpool (runProtoConn a) runProtoConn :: P2P.Proto a -> Connection -> Annex (Connection, Maybe a) runProtoConn _ ClosedConnection = return (ClosedConnection, Nothing) -runProtoConn a (OpenConnection conn) = do - v <- runFullProto Client conn a +runProtoConn a c@(OpenConnection (runst, conn)) = do + v <- runFullProto runst conn a -- When runFullProto fails, the connection is no longer usable, -- so close it. case v of @@ -99,7 +99,7 @@ runProtoConn a (OpenConnection conn) = do warning $ "Lost connection to peer (" ++ e ++ ")" liftIO $ closeConnection conn return (ClosedConnection, Nothing) - Right r -> return (OpenConnection conn, Just r) + Right r -> return (c, Just r) -- Uses an open connection if one is available in the ConnectionPool; -- otherwise opens a new connection. @@ -138,11 +138,20 @@ openConnection u addr = do myuuid <- getUUID authtoken <- fromMaybe nullAuthToken <$> loadP2PRemoteAuthToken addr - res <- liftIO $ runNetProto conn $ - P2P.auth myuuid authtoken + let proto = P2P.auth myuuid authtoken $ + -- Before 6.20180312, the protocol server + -- had a bug that made negotiating the + -- protocol version terminate the + -- connection. So, this must stay disabled + -- until the old version is not in use + -- anywhere. + --P2P.negotiateProtocolVersion P2P.maxProtocolVersion + return () + runst <- liftIO $ mkRunState Client + res <- runFullProto runst conn proto case res of Right (Just theiruuid) - | u == theiruuid -> return (OpenConnection conn) + | u == theiruuid -> return (OpenConnection (runst, conn)) | otherwise -> do liftIO $ closeConnection conn warning "Remote peer uuid seems to have changed." diff --git a/RemoteDaemon/Transport/Tor.hs b/RemoteDaemon/Transport/Tor.hs index 133aba1ec9..d97b9ab6b1 100644 --- a/RemoteDaemon/Transport/Tor.hs +++ b/RemoteDaemon/Transport/Tor.hs @@ -127,7 +127,8 @@ serveClient th u r q = bracket setup cleanup start authed conn theiruuid = bracket watchChangedRefs (liftIO . maybe noop stopWatchingChangedRefs) $ \crh -> do - v' <- runFullProto (Serving theiruuid crh) conn $ + runst <- liftIO $ mkRunState (Serving theiruuid crh) + v' <- runFullProto runst conn $ P2P.serveAuthed P2P.ServeReadWrite u case v' of Right () -> return () @@ -146,8 +147,7 @@ transport (RemoteRepo r gc) url@(RemoteURI uri) th ichan ochan = myuuid <- liftAnnex th getUUID authtoken <- fromMaybe nullAuthToken <$> liftAnnex th (loadP2PRemoteAuthToken addr) - res <- runNetProto conn $ - P2P.auth myuuid authtoken + res <- runNetProto conn $ P2P.auth myuuid authtoken noop case res of Right (Just theiruuid) -> do expecteduuid <- liftAnnex th $ getRepoUUID r diff --git a/doc/design/p2p_protocol.mdwn b/doc/design/p2p_protocol.mdwn index 183e2eb275..31571c9965 100644 --- a/doc/design/p2p_protocol.mdwn +++ b/doc/design/p2p_protocol.mdwn @@ -6,9 +6,23 @@ serializations are also possible. The line-based serialization is spoken by [[git-annex-shell], and by git-annex over tor. One peer is known as the client, and is the peer that initiates the -connection. The other peer is known as the server, and is the peer that the -client connects to. It's possible for two connections to be run at the same -time between the same two peers, in different directions. +connection and sends commands. The other peer is known as the server, and +is the peer that the client connects to. It's possible for two connections +to be run at the same time between the same two peers, in different +directions. + +## Errors + +Either the client or the server may send an error message at any +time. + +When the client sends an ERROR, the server will close the connection. + +If the server sends an ERROR in response to the client's +request, the connection will remain open, and the client can make +another request. + + ERROR this repository is read-only; write access denied ## Authentication @@ -16,7 +30,7 @@ The protocol genernally starts with authentication. However, if authentication already occurs on another layer, as is the case with git-annex-shell, authentication will be skipped. -The client starts by sending an authentication to the server, +The client starts by sending an authentication command to the server, along with its UUID. The AuthToken is some arbitrary token that has been agreed upon beforehand. @@ -33,18 +47,29 @@ Note that authentication does not guarantee that the client is talking to who they expect to be talking to. This, and encryption of the connection, are handled at a lower level. -## Errors +## Protocol version -Either the client or the server may send an error message at any -time. +The default protocol version is 0. The client can choose to +negotiate a new version with the server. This must come after +any authentication. -When the client sends an ERROR, the server will close the connection. +The client sends the highest protocol version it supports: -If the server sends an ERROR in response to the client's -request, the connection will remain open, and the client can make -another request. + VERSION 2 - ERROR this repository is read-only; write access denied +The server responds with the highest protocol version it supports +that is less than or equal to the version the client sent: + + VERSION 1 + +Now both client and server should use version 1. + +(Note that old versions of git-annex, which speak the P2P protocol +over tor, don't support this, and attempting to negotiate a version +will cause the server to hang up the connection. To deal with this +historical bug, the version is not currently negotiated when using the +protocol over tor. At some point in the future, when all peers can be +assumed to be upgraded, this will be changed.) ## Binary data @@ -54,11 +79,21 @@ on its own line, followed by a newline and the binary data. The Len value tells how many bytes of data to read. DATA 3 - foo + foo1 Note that there is no newline after the binary data; the next protocol message will come immediately after it. +In protocol version 1 and higher, the binary data is suffixed with one +additional byte. Normally that is "1". "0" is used to indicate when the +file being transferred changed content while it was being sent +(eg, it was unlocked and got edited). In protocol version 0, this +additional byte is not sent. + +If the sender finds itself unable to send as many bytes of data as it +promised (perhaps because a file got truncated while it was being sent), +its only option is to close the protocol connection. + ## Checking if content is present To check if a key is currently present on the server, the client sends: diff --git a/doc/todo/accellerate_ssh_remotes_with_git-annex-shell_mass_protocol.mdwn b/doc/todo/accellerate_ssh_remotes_with_git-annex-shell_mass_protocol.mdwn index f7b1908262..3387a3e5c4 100644 --- a/doc/todo/accellerate_ssh_remotes_with_git-annex-shell_mass_protocol.mdwn +++ b/doc/todo/accellerate_ssh_remotes_with_git-annex-shell_mass_protocol.mdwn @@ -39,10 +39,18 @@ implementation todos: * git-annex-shell p2pstdio currently always verifies content it receives. git-annex-shell recvkey has a speed optimisation, when it's told the file - being sent is locked, it can avoid an expensive verification. -* Maybe similar for transfers in the other direction? + being sent is locked, it can avoid an expensive verification, when + annex.verify=false. (Similar for transfers in the other direction.) + + The P2P protocol does not have a way to communicate when that happens, + and forces AlwaysVerify. + + It would be nice to support that, but if it added an extra round trip + to the P2P protocol, that could lose some of the speed gains. + * What happens when the assistant is running and some connections are open and it moves between networks? + * If it's unable to ssh to a host to run p2pstdio, it will fall back to the old method. What if the host is down, does this double the timeout?