diff --git a/CHANGELOG b/CHANGELOG index 58bfe59d5c..9e61ac4957 100644 --- a/CHANGELOG +++ b/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 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 diff --git a/CmdLine/GitAnnexShell.hs b/CmdLine/GitAnnexShell.hs index 55c3ae1ee7..aa952d18ad 100644 --- a/CmdLine/GitAnnexShell.hs +++ b/CmdLine/GitAnnexShell.hs @@ -1,6 +1,6 @@ {- git-annex-shell main program - - - Copyright 2010-2018 Joey Hess + - Copyright 2010-2021 Joey Hess - - 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 diff --git a/CmdLine/GitAnnexShell/Fields.hs b/CmdLine/GitAnnexShell/Fields.hs index 639adf3477..1e416cdb32 100644 --- a/CmdLine/GitAnnexShell/Fields.hs +++ b/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" diff --git a/Command/Commit.hs b/Command/Commit.hs deleted file mode 100644 index 1175a0d52e..0000000000 --- a/Command/Commit.hs +++ /dev/null @@ -1,32 +0,0 @@ -{- git-annex command - - - - Copyright 2012 Joey Hess - - - - 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 [] diff --git a/Command/LockContent.hs b/Command/LockContent.hs deleted file mode 100644 index c57801880b..0000000000 --- a/Command/LockContent.hs +++ /dev/null @@ -1,41 +0,0 @@ -{- git-annex-shell command - - - - Copyright 2015 Joey Hess - - - - 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." diff --git a/Command/RecvKey.hs b/Command/RecvKey.hs index 2b49ca84a6..e6832e32e2 100644 --- a/Command/RecvKey.hs +++ b/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, diff --git a/Command/SendKey.hs b/Command/SendKey.hs index 3af189f39e..5a8778bf23 100644 --- a/Command/SendKey.hs +++ b/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) - <$> Fields.getField Fields.associatedFile + let afile = AssociatedFile Nothing 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) diff --git a/Command/TransferInfo.hs b/Command/TransferInfo.hs deleted file mode 100644 index 2df9fa92fc..0000000000 --- a/Command/TransferInfo.hs +++ /dev/null @@ -1,69 +0,0 @@ -{- git-annex command - - - - Copyright 2012 Joey Hess - - - - 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 diff --git a/Remote/GCrypt.hs b/Remote/GCrypt.hs index 3b5e35ecce..9662e75d4a 100644 --- a/Remote/GCrypt.hs +++ b/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 - (AssociatedFile Nothing) + =<< Ssh.rsyncParamsRemote r Upload k f 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" diff --git a/Remote/Git.hs b/Remote/Git.hs index 1200f7ae9a..99ccc60330 100644 --- a/Remote/Git.hs +++ b/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 = - let fallback = Ssh.inAnnex repo key - in P2PHelper.checkpresent (Ssh.runProto rmt connpool (cantCheck rmt) fallback) key + checkremote = P2PHelper.checkpresent (Ssh.runProto rmt connpool (cantCheck rmt)) 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 - let fallback = Ssh.dropKey' repo key - P2PHelper.remove (Ssh.runProto r connpool (return False) fallback) key + | otherwise = P2PHelper.remove (Ssh.runProto r connpool (return False)) 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' :: Bool -> Remote -> State -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification -copyFromRemote' forcersync r st key file dest meterupdate vc = do +copyFromRemote 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'' repo forcersync r st@(State connpool _ _ _ _) key file dest meterupdate vc +copyFromRemote'' :: Git.Repo -> Remote -> State -> Key -> AssociatedFile -> FilePath -> MeterUpdate -> VerifyConfig -> Annex Verification +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 - then do - (ok, v) <- fallback meterupdate - if ok - then return v - else giveup "failed to retrieve content from remote" - else P2PHelper.retrieve + | Git.repoIsSsh repo = + 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 - 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 + | otherwise = noop wantHardLink :: Annex Bool wantHardLink = (annexHardLink <$> Annex.getGitConfig) diff --git a/Remote/Helper/P2P.hs b/Remote/Helper/P2P.hs index 2dd641a67e..f944f4fe43 100644 --- a/Remote/Helper/P2P.hs +++ b/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 diff --git a/Remote/Helper/Ssh.hs b/Remote/Helper/Ssh.hs index 6f0fd40712..bd6a9a1c3d 100644 --- a/Remote/Helper/Ssh.hs +++ b/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 unlocked r direction key file (AssociatedFile afile) = do +rsyncParamsRemote :: Remote -> Direction -> Key -> FilePath -> Annex [CommandParam] +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 r connpool badproto fallback proto = Just <$> - (getP2PSshConnection r connpool >>= maybe fallback go) +runProto :: Remote -> P2PSshConnectionPool -> Annex a -> P2P.Proto a -> Annex (Maybe a) +runProto r connpool onerr proto = Just <$> + (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 - -- error or a network error. - Nothing -> badproto + Nothing -> onerr runProtoConn :: P2P.Proto a -> P2PSshConnection -> Annex (P2PSshConnection, Maybe a) runProtoConn _ P2P.ClosedConnection = return (P2P.ClosedConnection, Nothing) diff --git a/Remote/P2P.hs b/Remote/P2P.hs index 7f3817c1bf..2c6056a91c 100644 --- a/Remote/P2P.hs +++ b/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) - , retrieveKeyFile = retrieve gc (const protorunner) + , storeKey = store gc protorunner + , retrieveKeyFile = retrieve gc protorunner , retrieveKeyFileCheap = Nothing , retrievalSecurityPolicy = RetrievalAllKeysSecure , removeKey = remove protorunner diff --git a/doc/git-annex-shell.mdwn b/doc/git-annex-shell.mdwn index a1267d0909..4224c40f6f 100644 --- a/doc/git-annex-shell.mdwn +++ b/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, - and exits zero if so. + This causes git-annex-shell to communicate using the git-annex p2p + protocol over stdio. - Exits 1 if the key is certainly not present in the annex. - Exits 100 if it's unable to tell (perhaps the key is in the process of - 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. + The uuid is the one belonging to the repository that will be + communicating with git-annex-shell. * 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 - protocol over stdio. When supported by git-annex-shell, this allows - multiple actions to be run over a single connection, improving speed. + This checks if all specified keys are present in the annex, + and exits zero if so. - The uuid is the one belonging to the repository that will be - communicating with git-annex-shell. + Exits 1 if the key is certainly not present in the annex. + 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=, - unlocked=, direct=, and autoinit= + Currently used fields are autoinit= and remoteuuid= # HOOK diff --git a/doc/todo/p2p_protocol_flag_days.mdwn b/doc/todo/p2p_protocol_flag_days.mdwn index 93902a9090..967295b77a 100644 --- a/doc/todo/p2p_protocol_flag_days.mdwn +++ b/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]] diff --git a/git-annex.cabal b/git-annex.cabal index e4bc17fd73..131e050954 100644 --- a/git-annex.cabal +++ b/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