Merge branch 'p2pflagday'

CHANGELOG

@@ -1,3 +1,13 @@
+git-annex (8.20211012) UNRELEASED; urgency=medium
+
+  * Removed support for accessing git remotes that use versions of
+    git-annex older than 6.20180312.
+  * git-annex-shell: Removed several commands that were only needed to
+    support git-annex versions older than 6.20180312.
+    (lockcontent, recvkey, sendkey, transferinfo, commit)
+
+ -- Joey Hess <id@joeyh.name>  Mon, 11 Oct 2021 14:09:13 -0400
+
 git-annex (8.20211011) upstream; urgency=medium
 
   * Added annex.bwlimit and remote.name.annex-bwlimit config to limit

CmdLine/GitAnnexShell.hs

@@ -1,6 +1,6 @@
 {- git-annex-shell main program
  -
- - Copyright 2010-2018 Joey Hess <id@joeyh.name>
+ - Copyright 2010-2021 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU AGPL version 3 or higher.
  -}
@@ -20,16 +20,13 @@ import Remote.GCrypt (getGCryptUUID)
 import P2P.Protocol (ServerMode(..))
 
 import qualified Command.ConfigList
-import qualified Command.InAnnex
-import qualified Command.LockContent
-import qualified Command.DropKey
-import qualified Command.RecvKey
-import qualified Command.SendKey
-import qualified Command.TransferInfo
-import qualified Command.Commit
 import qualified Command.NotifyChanges
 import qualified Command.GCryptSetup
 import qualified Command.P2PStdIO
+import qualified Command.InAnnex
+import qualified Command.RecvKey
+import qualified Command.SendKey
+import qualified Command.DropKey
 
 import qualified Data.Map as M
 
@@ -42,20 +39,17 @@ cmdsMap = M.fromList $ map mk
   where
 	readonlycmds = map addGlobalOptions
 		[ Command.ConfigList.cmd
-		, gitAnnexShellCheck Command.InAnnex.cmd
-		, gitAnnexShellCheck Command.LockContent.cmd
-		, gitAnnexShellCheck Command.SendKey.cmd
-		, gitAnnexShellCheck Command.TransferInfo.cmd
 		, gitAnnexShellCheck Command.NotifyChanges.cmd
 		-- p2pstdio checks the enviroment variables to
 		-- determine the security policy to use
 		, gitAnnexShellCheck Command.P2PStdIO.cmd
+		, gitAnnexShellCheck Command.InAnnex.cmd
+		, gitAnnexShellCheck Command.SendKey.cmd
 		]
 	appendcmds = readonlycmds ++ map addGlobalOptions
 		[ gitAnnexShellCheck Command.RecvKey.cmd
-		, gitAnnexShellCheck Command.Commit.cmd
 		]
-	allcmds = map addGlobalOptions
+	allcmds = appendcmds ++ map addGlobalOptions
 		[ gitAnnexShellCheck Command.DropKey.cmd
 		, Command.GCryptSetup.cmd
 		]
@@ -67,7 +61,7 @@ cmdsFor :: ServerMode -> [Command]
 cmdsFor = fromMaybe [] . flip M.lookup cmdsMap
 
 cmdsList :: [Command]
-cmdsList = concat $ M.elems cmdsMap
+cmdsList = nub $ concat $ M.elems cmdsMap
 
 addGlobalOptions :: Command -> Command
 addGlobalOptions c = c { cmdglobaloptions = globalOptions ++ cmdglobaloptions c }
@@ -166,9 +160,6 @@ parseFields = map (separate (== '='))
 checkField :: (String, String) -> Bool
 checkField (field, val)
 	| field == fieldName remoteUUID = fieldCheck remoteUUID val
-	| field == fieldName associatedFile = fieldCheck associatedFile val
-	| field == fieldName unlocked = fieldCheck unlocked val
-	| field == fieldName direct = fieldCheck direct val
 	| field == fieldName autoInit = fieldCheck autoInit val
 	| otherwise = False
 

CmdLine/GitAnnexShell/Fields.hs

@@ -9,7 +9,6 @@ module CmdLine.GitAnnexShell.Fields where
 
 import Annex.Common
 import qualified Annex
-import Git.FilePath
 
 import Data.Char
 
@@ -27,14 +26,6 @@ remoteUUID = Field "remoteuuid" $
 	-- does it look like a UUID?
 	all (\c -> isAlphaNum c || c == '-')
 
-associatedFile :: Field
-associatedFile = Field "associatedfile" $ \f ->
-	-- is the file a safe relative filename?
-	not (absoluteGitPath (toRawFilePath f)) && not ("../" `isPrefixOf` f)
-
-direct :: Field
-direct = Field "direct" $ \f -> f == "1"
-
 unlocked :: Field
 unlocked = Field "unlocked" $ \f -> f == "1"
 

Command/Commit.hs

@@ -1,32 +0,0 @@
-{- git-annex command
- -
- - Copyright 2012 Joey Hess <id@joeyh.name>
- -
- - Licensed under the GNU AGPL version 3 or higher.
- -}
-
-module Command.Commit where
-
-import Command
-import qualified Annex.Branch
-import qualified Git
-import Git.Types
-
-cmd :: Command
-cmd = command "commit" SectionPlumbing 
-	"commits any staged changes to the git-annex branch"
-	paramNothing (withParams seek)
-
-seek :: CmdParams -> CommandSeek
-seek = withNothing (commandAction start)
-
-start :: CommandStart
-start = starting "commit" ai si $ do
-	Annex.Branch.commit =<< Annex.Branch.commitMessage
-	_ <- runhook <=< inRepo $ Git.hookPath "annex-content"
-	next $ return True
-  where
-	runhook (Just hook) = liftIO $ boolSystem hook []
-	runhook Nothing = return True
-	ai = ActionItemOther (Just (fromRef Annex.Branch.name))
-	si = SeekInput []

Command/LockContent.hs

@@ -1,41 +0,0 @@
-{- git-annex-shell command
- -
- - Copyright 2015 Joey Hess <id@joeyh.name>
- -
- - Licensed under the GNU AGPL version 3 or higher.
- -}
-
-module Command.LockContent where
-
-import Command
-import Annex.Content
-import Remote.Helper.Ssh (contentLockedMarker)
-import Utility.SimpleProtocol
-
-cmd :: Command
-cmd = noCommit $ 
-	command "lockcontent" SectionPlumbing 
-		"locks key's content in the annex, preventing it being dropped"
-		paramKey
-		(withParams seek)
-
-seek :: CmdParams -> CommandSeek
-seek = withWords (commandAction . start)
-
--- First, lock the content, then print out "OK". 
--- Wait for the caller to send a line before dropping the lock.
-start :: [String] -> CommandStart
-start [ks] = do
-	ok <- lockContentShared k (const locksuccess)
-		`catchNonAsync` (const $ return False)
-	liftIO $ if ok
-		then exitSuccess
-		else exitFailure
-  where
-	k = fromMaybe (giveup "bad key") (deserializeKey ks)
-	locksuccess = liftIO $ do
-		putStrLn contentLockedMarker
-		hFlush stdout
-		_ <- getProtocolLine stdin
-		return True
-start _ = giveup "Specify exactly 1 key."

Command/RecvKey.hs

@@ -15,7 +15,6 @@ import Utility.Rsync
 import Types.Transfer
 import Logs.Location
 import Command.SendKey (fieldTransfer)
-import qualified CmdLine.GitAnnexShell.Fields as Fields
 
 cmd :: Command
 cmd = noCommit $ command "recvkey" SectionPlumbing 
@@ -27,14 +26,9 @@ seek = withKeys (commandAction . start)
 
 start :: (SeekInput, Key) -> CommandStart
 start (_, key) = fieldTransfer Download key $ \_p -> do
-	-- Always verify content when a repo is sending an unlocked file,
-	-- as the file could change while being transferred.
-	fromunlocked <- (isJust <$> Fields.getField Fields.unlocked)
-		<||> (isJust <$> Fields.getField Fields.direct)
-	let verify = if fromunlocked then AlwaysVerify else DefaultVerify
 	-- This matches the retrievalSecurityPolicy of Remote.Git
 	let rsp = RetrievalAllKeysSecure
-	ifM (getViaTmp rsp verify key (AssociatedFile Nothing) go)
+	ifM (getViaTmp rsp DefaultVerify key (AssociatedFile Nothing) go)
 		( do
 			logStatus key InfoPresent
 			-- forcibly quit after receiving one key,

Command/SendKey.hs

@@ -46,8 +46,7 @@ start (_, key) = do
 fieldTransfer :: Direction -> Key -> (MeterUpdate -> Annex Bool) -> CommandStart
 fieldTransfer direction key a = do
 	fastDebug "Command.SendKey" "transfer start"
-	afile <- AssociatedFile . (fmap toRawFilePath)
+	let afile = AssociatedFile Nothing
-		<$> Fields.getField Fields.associatedFile
 	ok <- maybe (a $ const noop)
 		-- Using noRetry here because we're the sender.
 		(\u -> runner (Transfer direction (toUUID u) (fromKey id key)) afile Nothing noRetry a)

Command/TransferInfo.hs

@@ -1,69 +0,0 @@
-{- git-annex command
- -
- - Copyright 2012 Joey Hess <id@joeyh.name>
- -
- - Licensed under the GNU AGPL version 3 or higher.
- -}
-
-module Command.TransferInfo where
-
-import Command
-import Annex.Content
-import Types.Transfer
-import Logs.Transfer
-import Utility.Metered
-import Utility.SimpleProtocol
-import qualified CmdLine.GitAnnexShell.Fields as Fields
-import qualified Utility.RawFilePath as R
-
-cmd :: Command
-cmd = noCommit $ 
-	command "transferinfo" SectionPlumbing
-		"updates sender on number of bytes of content received"
-		paramKey (withParams seek)
-
-seek :: CmdParams -> CommandSeek
-seek = withWords (commandAction . start)
-
-{- Security:
- - 
- - The transfer info file contains the user-supplied key, but
- - the built-in guards prevent slashes in it from showing up in the filename.
- - It also contains the UUID of the remote. But slashes are also filtered
- - out of that when generating the filename.
- - 
- - Checks that the key being transferred is inAnnex, to prevent
- - malicious spamming of bogus keys. Does not check that a transfer
- - of the key is actually in progress, because this could be started
- - concurrently with sendkey, and win the race.
- -}
-start :: [String] -> CommandStart
-start (k:[]) = do
-	case deserializeKey k of
-		Nothing -> error "bad key"
-		(Just key) -> whenM (inAnnex key) $ do
-			afile <- AssociatedFile . (fmap toRawFilePath)
-				<$> Fields.getField Fields.associatedFile
-			u <- maybe (error "missing remoteuuid") toUUID
-				<$> Fields.getField Fields.remoteUUID
-			let t = Transfer
-				{ transferDirection = Upload
-				, transferUUID = u
-				, transferKeyData = fromKey id key
-				}
-			tinfo <- liftIO $ startTransferInfo afile
-			(update, tfile, createtfile, _) <- mkProgressUpdater t tinfo
-			createtfile
-			liftIO $ mapM_ void
-				[ tryIO $ forever $ do
-					bytes <- readUpdate
-					maybe (error "transferinfo protocol error")
-						(update . toBytesProcessed) bytes
-				, tryIO $ R.removeLink tfile
-				, exitSuccess
-				]
-	stop
-start _ = giveup "wrong number of parameters"
-
-readUpdate :: IO (Maybe Integer)
-readUpdate = maybe Nothing readish <$> getProtocolLine stdin

Remote/GCrypt.hs

@@ -396,8 +396,7 @@ store' repo r rsyncopts accessmethod
 		then fileStorer $ \k f p -> do
 			oh <- mkOutputHandler
 			ok <- Ssh.rsyncHelper oh (Just p)
-				=<< Ssh.rsyncParamsRemote False r Upload k f
+				=<< Ssh.rsyncParamsRemote r Upload k f
-					(AssociatedFile Nothing)
 			unless ok $
 				giveup "rsync failed"
 		else storersync
@@ -418,9 +417,8 @@ retrieve' repo r rsyncopts accessmethod
 			sink =<< liftIO (L.readFile $ gCryptLocation repo k)
 	| Git.repoIsSsh repo = if accessShell r
 		then fileRetriever $ \f k p -> do
-			ps <- Ssh.rsyncParamsRemote False r Download k
+			ps <- Ssh.rsyncParamsRemote r Download k
 				(fromRawFilePath f)
-				(AssociatedFile Nothing)
 			oh <- mkOutputHandler
 			unlessM (Ssh.rsyncHelper oh (Just p) ps) $
 				giveup "rsync failed"

Remote/Git.hs

@@ -48,7 +48,6 @@ import Logs.Location
 import Utility.Metered
 import Utility.Env
 import Utility.Batch
-import Utility.SimpleProtocol
 import Remote.Helper.Git
 import Remote.Helper.Messages
 import Remote.Helper.ExportImport
@@ -70,7 +69,6 @@ import qualified Utility.RawFilePath as R
 #endif
 
 import Control.Concurrent
-import Control.Concurrent.MSampleVar
 import qualified Data.Map as M
 import qualified Data.ByteString as S
 import Network.URI
@@ -413,9 +411,7 @@ inAnnex' repo rmt st@(State connpool duc _ _ _) key
 			( return True
 			, giveup "not found"
 			)
-	checkremote = 
+	checkremote = P2PHelper.checkpresent (Ssh.runProto rmt connpool (cantCheck rmt)) key
-		let fallback = Ssh.inAnnex repo key
-		in P2PHelper.checkpresent (Ssh.runProto rmt connpool (cantCheck rmt) fallback) key
 	checklocal = ifM duc
 		( guardUsable repo (cantCheck repo) $
 			maybe (cantCheck repo) return
@@ -458,9 +454,7 @@ dropKey' repo r st@(State connpool duc _ _ _) key
 		, giveup "remote does not have expected annex.uuid value"
 		)
 	| Git.repoIsHttp repo = giveup "dropping from http remote not supported"
-	| otherwise = commitOnCleanup repo r st $ do
+	| otherwise = P2PHelper.remove (Ssh.runProto r connpool (return False)) key
-		let fallback = Ssh.dropKey' repo key
-		P2PHelper.remove (Ssh.runProto r connpool (return False) fallback) key
 
 lockKey :: Remote -> State -> Key -> (VerifiedCopy -> Annex r) -> Annex r
 lockKey r st key callback = do
@@ -482,63 +476,20 @@ lockKey' repo r st@(State connpool duc _ _ _) key callback
 		)
 	| Git.repoIsSsh repo = do
 		showLocking r
-		let withconn = Ssh.withP2PSshConnection r connpool fallback
+		let withconn = Ssh.withP2PSshConnection r connpool failedlock
 		P2PHelper.lock withconn Ssh.runProtoConn (uuid r) key callback
 	| otherwise = failedlock
   where
-	fallback = withNullHandle $ \nullh -> do
-		Just (cmd, params) <- Ssh.git_annex_shell ConsumeStdin
-			repo "lockcontent"
-			[Param $ serializeKey key] []
-		let p = (proc cmd (toCommand params))
-			{ std_in = CreatePipe
-			, std_out = CreatePipe
-			, std_err = UseHandle nullh
-			}
-		bracketIO (createProcess p) cleanupProcess fallback'
-
-	fallback' (Just hin, Just hout, Nothing, p) = do
-		v <- liftIO $ tryIO $ getProtocolLine hout
-		let signaldone = void $ tryNonAsync $ liftIO $ mapM_ tryNonAsync
-			[ hPutStrLn hout ""
-			, hFlush hout
-			, hClose hin
-			, hClose hout
-			, void $ waitForProcess p
-			]
-		let checkexited = not . isJust <$> getProcessExitCode p
-		case v of
-			Left _exited -> do
-				showNote "lockcontent failed"
-				liftIO $ do
-					hClose hin
-					hClose hout
-					void $ waitForProcess p
-				failedlock
-			Right l 
-				| l == Just Ssh.contentLockedMarker -> bracket_
-					noop
-					signaldone 
-					(withVerifiedCopy LockedCopy r checkexited callback)
-				| otherwise -> do
-					showNote "lockcontent failed"
-					signaldone
-					failedlock
-	fallback' _ = error "internal"
-
 	failedlock = giveup "can't lock content"
 
 {- Tries to copy a key's content from a remote's annex to a file. -}
 copyFromRemote :: Remote -> State -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification
-copyFromRemote = copyFromRemote' False
+copyFromRemote r st key file dest meterupdate vc = do
-
-copyFromRemote' :: Bool -> Remote -> State -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification
-copyFromRemote' forcersync r st key file dest meterupdate vc = do
 	repo <- getRepo r
-	copyFromRemote'' repo forcersync r st key file dest meterupdate vc
+	copyFromRemote'' repo r st key file dest meterupdate vc
 
-copyFromRemote'' :: Git.Repo -> Bool -> Remote -> State -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification
+copyFromRemote'' :: Git.Repo -> Remote -> State -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification
-copyFromRemote'' repo forcersync r st@(State connpool _ _ _ _) key file dest meterupdate vc
+copyFromRemote'' repo r st@(State connpool _ _ _ _) key file dest meterupdate vc
 	| Git.repoIsHttp repo = do
 		iv <- startVerifyKeyContentIncrementally vc key
 		gc <- Annex.getGitConfig
@@ -566,90 +517,12 @@ copyFromRemote'' repo forcersync r st@(State connpool _ _ _ _) key file dest met
 					then return v
 					else giveup "failed to retrieve content from remote"
 			Nothing -> giveup "content is not present in remote"
-	| Git.repoIsSsh repo = if forcersync
+	| Git.repoIsSsh repo =
-		then do
+		P2PHelper.retrieve
-			(ok, v) <- fallback meterupdate
-			if ok
-				then return v
-				else giveup "failed to retrieve content from remote"
-		else P2PHelper.retrieve
 			(gitconfig r)
-			(\p -> Ssh.runProto r connpool (return (False, UnVerified)) (fallback p))
+			(Ssh.runProto r connpool (return (False, UnVerified)))
 			key file dest meterupdate vc
 	| otherwise = giveup "copying from non-ssh, non-http remote not supported"
-  where
-	fallback p = unVerified $ feedprogressback $ \p' -> do
-		oh <- mkOutputHandlerQuiet
-		Ssh.rsyncHelper oh (Just (combineMeterUpdate p' p))
-			=<< Ssh.rsyncParamsRemote False r Download key dest file
-
-	{- Feed local rsync's progress info back to the remote,
-	 - by forking a feeder thread that runs
-	 - git-annex-shell transferinfo at the same time
-	 - git-annex-shell sendkey is running.
-	 -
-	 - To avoid extra password prompts, this is only done when ssh
-	 - connection caching is supported.
-	 - Note that it actually waits for rsync to indicate
-	 - progress before starting transferinfo, in order
-	 - to ensure ssh connection caching works and reuses 
-	 - the connection set up for the sendkey.
-	 -
-	 - Also note that older git-annex-shell does not support
-	 - transferinfo, so stderr is dropped and failure ignored.
-	 -}
-	feedprogressback a = ifM (isJust <$> sshCacheDir)
-		( feedprogressback' a
-		, a $ const noop
-		)
-	feedprogressback' a = do
-		u <- getUUID
-		let AssociatedFile afile = file
-		let fields = (Fields.remoteUUID, fromUUID u)
-			: maybe [] (\f -> [(Fields.associatedFile, fromRawFilePath f)]) afile
-		Just (cmd, params) <- Ssh.git_annex_shell ConsumeStdin
-			repo "transferinfo" 
-			[Param $ serializeKey key] fields
-		v <- liftIO (newEmptySV :: IO (MSampleVar Integer))
-		pv <- liftIO $ newEmptyMVar
-		tid <- liftIO $ forkIO $ void $ tryIO $ do
-			bytes <- readSV v
-			p <- createProcess $
-				 (proc cmd (toCommand params))
-					{ std_in = CreatePipe
-					, std_err = CreatePipe
-					}
-			putMVar pv p
-			hClose $ stderrHandle p
-			let h = stdinHandle p
-			let send b = do
-				hPrint h b
-				hFlush h
-			send bytes
-			forever $
-				send =<< readSV v
-		let feeder = \n -> do
-			meterupdate n
-			writeSV v (fromBytesProcessed n)
-
-		-- It can easily take 0.3 seconds to clean up after
-		-- the transferinfo, and all that's involved is shutting
-		-- down the process and associated thread cleanly. So,
-		-- do it in the background.
-		let cleanup = forkIO $ do
-			void $ tryIO $ killThread tid
-			void $ tryNonAsync $ 
-				maybe noop (void . waitForProcess . processHandle)
-					=<< tryTakeMVar pv
-
-		let forcestop = do
-			void $ tryIO $ killThread tid
-			void $ tryNonAsync $ 
-				maybe noop cleanupProcess
-					=<< tryTakeMVar pv
-
-		bracketIO noop (const cleanup) (const $ a feeder)
-			`onException` liftIO forcestop
 
 copyFromRemoteCheap :: State -> Git.Repo -> Maybe (Key -> AssociatedFile -> FilePath -> Annex ())
 #ifndef mingw32_HOST_OS
@@ -681,9 +554,9 @@ copyToRemote' repo r st@(State connpool duc _ _ _) key file meterupdate
 			copylocal =<< Annex.Content.prepSendAnnex' key
 		, giveup "remote does not have expected annex.uuid value"
 		)
-	| Git.repoIsSsh repo = commitOnCleanup repo r st $
+	| Git.repoIsSsh repo =
 		P2PHelper.store (gitconfig r)
-			(Ssh.runProto r connpool (return False) . copyremotefallback)
+			(Ssh.runProto r connpool (return False))
 			key file meterupdate
 		
 	| otherwise = giveup "copying to non-ssh repo not supported"
@@ -715,16 +588,6 @@ copyToRemote' repo r st@(State connpool duc _ _ _) key file meterupdate
 			)
 		unless res $
 			giveup "failed to send content to remote"
-	copyremotefallback p = either (const False) id
-		<$> tryNonAsync (copyremotefallback' p)
-	copyremotefallback' p = Annex.Content.sendAnnex key noop $ \object -> do
-		-- This is too broad really, but recvkey normally
-		-- verifies content anyway, so avoid complicating
-		-- it with a local sendAnnex check and rollback.
-		let unlocked = True
-		oh <- mkOutputHandlerQuiet
-		Ssh.rsyncHelper oh (Just p)
-			=<< Ssh.rsyncParamsRemote unlocked r Upload key object file
 
 fsckOnRemote :: Git.Repo -> [CommandParam] -> Annex (IO Bool)
 fsckOnRemote r params
@@ -816,21 +679,7 @@ commitOnCleanup repo r st a = go `after` a
 		| not $ Git.repoIsUrl repo = onLocalFast st $
 			doQuietSideAction $
 				Annex.Branch.commit =<< Annex.Branch.commitMessage
-		| otherwise = do
+		| otherwise = noop
-			Just (shellcmd, shellparams) <-
-				Ssh.git_annex_shell NoConsumeStdin
-					repo "commit" [] []
-			
-			-- Throw away stderr, since the remote may not
-			-- have a new enough git-annex shell to
-			-- support committing.
-			liftIO $ void $ catchMaybeIO $ withNullHandle $ \nullh ->
-				let p = (proc shellcmd (toCommand shellparams))
-					{ std_out = UseHandle nullh
-					, std_err = UseHandle nullh
-					}
-				in withCreateProcess p $ \_ _ _ ->
-					forceSuccessProcess p
 
 wantHardLink :: Annex Bool
 wantHardLink = (annexHardLink <$> Annex.getGitConfig)

Remote/Helper/P2P.hs

@@ -31,22 +31,22 @@ type ProtoConnRunner c = forall a. P2P.Proto a -> ClosableConnection c -> Annex
 -- the pool when done.
 type WithConn a c = (ClosableConnection c -> Annex (ClosableConnection c, a)) -> Annex a
 
-store :: RemoteGitConfig -> (MeterUpdate -> ProtoRunner Bool) -> Key -> AssociatedFile -> MeterUpdate -> Annex ()
+store :: RemoteGitConfig -> ProtoRunner Bool -> Key -> AssociatedFile -> MeterUpdate -> Annex ()
 store gc runner k af p = do
 	let sizer = KeySizer k (fmap (toRawFilePath . fst) <$> prepSendAnnex k)
 	let bwlimit = remoteAnnexBwLimit gc
 	metered (Just p) sizer bwlimit $ \_ p' ->
-		runner p' (P2P.put k af p') >>= \case
+		runner (P2P.put k af p') >>= \case
 			Just True -> return ()
 			Just False -> giveup "Transfer failed"
 			Nothing -> remoteUnavail
 
-retrieve :: RemoteGitConfig -> (MeterUpdate -> ProtoRunner (Bool, Verification)) -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification
+retrieve :: RemoteGitConfig -> (ProtoRunner (Bool, Verification)) -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification
 retrieve gc runner k af dest p verifyconfig = do
 	iv <- startVerifyKeyContentIncrementally verifyconfig k
 	let bwlimit = remoteAnnexBwLimit gc
 	metered (Just p) k bwlimit $ \m p' -> 
-		runner p' (P2P.get dest k iv af m p') >>= \case
+		runner (P2P.get dest k iv af m p') >>= \case
 			Just (True, v) -> return v
 			Just (False, _) -> giveup "Transfer failed"
 			Nothing -> remoteUnavail

Remote/Helper/Ssh.hs

@@ -130,20 +130,14 @@ rsyncHelper oh m params = do
 
 {- Generates rsync parameters that ssh to the remote and asks it
  - to either receive or send the key's content. -}
-rsyncParamsRemote :: Bool -> Remote -> Direction -> Key -> FilePath -> AssociatedFile -> Annex [CommandParam]
+rsyncParamsRemote :: Remote -> Direction -> Key -> FilePath -> Annex [CommandParam]
-rsyncParamsRemote unlocked r direction key file (AssociatedFile afile) = do
+rsyncParamsRemote r direction key file = do
 	u <- getUUID
-	let fields = (Fields.remoteUUID, fromUUID u)
-		: (Fields.unlocked, if unlocked then "1" else "")
-		-- Send direct field for unlocked content, for backwards
-		-- compatability.
-		: (Fields.direct, if unlocked then "1" else "")
-		: maybe [] (\f -> [(Fields.associatedFile, fromRawFilePath f)]) afile
 	repo <- getRepo r
 	Just (shellcmd, shellparams) <- git_annex_shell ConsumeStdin repo
 		(if direction == Download then "sendkey" else "recvkey")
 		[ Param $ serializeKey key ]
-		fields
+		[(Fields.remoteUUID, fromUUID u)]
 	-- Convert the ssh command into rsync command line.
 	let eparam = rsyncShell (Param shellcmd:shellparams)
 	o <- rsyncParams r direction
@@ -183,11 +177,6 @@ rsyncParams r direction = do
 		| otherwise = remoteAnnexRsyncUploadOptions gc
 	gc = gitconfig r
 
--- Used by git-annex-shell lockcontent to indicate the content is
--- successfully locked.
-contentLockedMarker :: String
-contentLockedMarker = "OK"
-
 -- A connection over ssh to git-annex shell speaking the P2P protocol.
 type P2PSshConnection = P2P.ClosableConnection
 	(P2P.RunState, P2P.P2PConnection, ProcessHandle, TVar StderrHandlerState)
@@ -320,9 +309,9 @@ newStderrHandler errh ph = do
 
 -- Runs a P2P Proto action on a remote when it supports that,
 -- otherwise the fallback action.
-runProto :: Remote -> P2PSshConnectionPool -> Annex a -> Annex a -> P2P.Proto a -> Annex (Maybe a)
+runProto :: Remote -> P2PSshConnectionPool -> Annex a -> P2P.Proto a -> Annex (Maybe a)
-runProto r connpool badproto fallback proto = Just <$>
+runProto r connpool onerr proto = Just <$>
-	(getP2PSshConnection r connpool >>= maybe fallback go)
+	(getP2PSshConnection r connpool >>= maybe onerr go)
   where
 	go c = do
 		(c', v) <- runProtoConn proto c
@@ -330,9 +319,7 @@ runProto r connpool badproto fallback proto = Just <$>
 			Just res -> do
 				liftIO $ storeP2PSshConnection connpool c'
 				return res
-			-- Running the proto failed, either due to a protocol
+			Nothing -> onerr
-			-- error or a network error.
-			Nothing -> badproto
 
 runProtoConn :: P2P.Proto a -> P2PSshConnection -> Annex (P2PSshConnection, Maybe a)
 runProtoConn _ P2P.ClosedConnection = return (P2P.ClosedConnection, Nothing)

Remote/P2P.hs

@@ -55,8 +55,8 @@ chainGen addr r u rc gc rs = do
 		{ uuid = u
 		, cost = cst
 		, name = Git.repoDescribe r
-		, storeKey = store gc (const protorunner)
+		, storeKey = store gc protorunner
-		, retrieveKeyFile = retrieve gc (const protorunner)
+		, retrieveKeyFile = retrieve gc protorunner
 		, retrieveKeyFileCheap = Nothing
 		, retrievalSecurityPolicy = RetrievalAllKeysSecure
 		, removeKey = remove protorunner

doc/git-annex-shell.mdwn

@@ -31,55 +31,16 @@ first "/~/" or "/~user/" is expanded to the specified home directory.
 
   When run in a repository that does not yet have an annex.uuid, one
   will be created, as long as a git-annex branch has already been pushed to
-  the repository, or if the autoinit= flag is used to indicate
+  the repository, or if the autoinit=1 flag is used to indicate
   initialization is desired.
 
-* inannex directory [key ...]
+* p2pstdio directory uuid
 
-  This checks if all specified keys are present in the annex, 
+  This causes git-annex-shell to communicate using the git-annex p2p
-  and exits zero if so.
+  protocol over stdio.
 
-  Exits 1 if the key is certainly not present in the annex.
+  The uuid is the one belonging to the repository that will be
-  Exits 100 if it's unable to tell (perhaps the key is in the process of
+  communicating with git-annex-shell.
-  being removed from the annex).
-
-* lockcontent directory key
-
-  This locks a key's content in place in the annex, preventing it from
-  being dropped.
-
-  Once the content is successfully locked, outputs "OK". Then the content
-  remains locked until a newline is received from the caller or the
-  connection is broken.
-
-  Exits nonzero if the content is not present, or could not be locked.
-
-* dropkey directory [key ...]
-
-  This drops the annexed data for the specified keys.
-
-* recvkey directory key
-
-  This runs rsync in server mode to receive the content of a key,
-  and stores the content in the annex.
-
-* sendkey directory key
-
-  This runs rsync in server mode to transfer out the content of a key.
-
-* transferinfo directory key
-
-  This is typically run at the same time as sendkey is sending a key
-  to the remote. Using it is optional, but is used to update
-  progress information for the transfer of the key.
-
-  It reads lines from standard input, each giving the number of bytes
-  that have been received so far. 
-
-* commit directory
-
-  This commits any staged changes to the git-annex branch.
-  It also runs the annex-content hook.
 
 * notifychanges directory
 
@@ -90,20 +51,38 @@ first "/~/" or "/~user/" is expanded to the specified home directory.
 
   Sets up a repository as a gcrypt repository.
 
-* p2pstdio directory uuid
+* inannex directory [key ...]
 
-  This causes git-annex-shell to communicate using the git-annex p2p
+  This checks if all specified keys are present in the annex, 
-  protocol over stdio. When supported by git-annex-shell, this allows
+  and exits zero if so.
-  multiple actions to be run over a single connection, improving speed.
 
-  The uuid is the one belonging to the repository that will be
+  Exits 1 if the key is certainly not present in the annex.
-  communicating with git-annex-shell.
+  Exits 100 if it's unable to tell (perhaps the key is in the process of
+  being removed from the annex).
+  
+  Used only by the gcrypt special remote.
+
+* recvkey directory key
+
+  This runs rsync in server mode to receive the content of a key,
+  and stores the content in the annex.
+  
+  Used only by the gcrypt special remote.
+
+* sendkey directory key
+
+  This runs rsync in server mode to transfer out the content of a key.
+  
+  Used only by the gcrypt special remote.
+
+* dropkey directory [key ...]
+
+  This drops the annexed data for the specified keys.
+  
+  Used only by the gcrypt special remote.
 
 # OPTIONS
 
-Most options are the same as in git-annex. The ones specific
-to git-annex-shell are:
-
 * --uuid=UUID
 
   git-annex uses this to specify the UUID of the repository it was expecting
@@ -117,8 +96,7 @@ to git-annex-shell are:
   past versions of git-annex-shell (that ignore these, but would choke
   on new dashed options).
 
-  Currently used fields include remoteuuid=, associatedfile=,
+  Currently used fields are autoinit= and remoteuuid=
-  unlocked=, direct=, and autoinit=
 
 # HOOK
 

doc/todo/p2p_protocol_flag_days.mdwn

@@ -21,4 +21,6 @@ can be assumed to be upgraded to 6.20180312, this fallback can be removed.
 It will allows removing a lot of code from git-annex-shell and a lot of
 fallback code from Remote.Git.
 
+> This part is done now. --[[Joey]]
+
 [[!tag confirmed]]

git-annex.cabal

@@ -728,7 +728,6 @@ Executable git-annex
     Command.Benchmark
     Command.CalcKey
     Command.CheckPresentKey
-    Command.Commit
     Command.Config
     Command.ConfigList
     Command.ContentLocation
@@ -768,7 +767,6 @@ Executable git-annex
     Command.Inprogress
     Command.List
     Command.Lock
-    Command.LockContent
     Command.Log
     Command.LookupKey
     Command.Map
@@ -809,7 +807,6 @@ Executable git-annex
     Command.Sync
     Command.Test
     Command.TestRemote
-    Command.TransferInfo
     Command.Transferrer
     Command.TransferKey
     Command.TransferKeys