remove git-annex-shell compat code
* 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) The P2P protocol was added in that version, and used ever since, so this code was only needed for interop with older versions. "git-annex-shell commit" is used by newer git-annex versions, though unnecessarily so, because the p2pstdio command makes a single commit at shutdown. Luckily, it was run with stderr and stdout sent to /dev/null, and non-zero exit status or other exceptions are caught and ignored. So, that was able to be removed from git-annex-shell too. git-annex-shell inannex, recvkey, sendkey, and dropkey are still used by gcrypt special remotes accessed over ssh, so those had to be kept. It would probably be possible to convert that to using the P2P protocol, but it would be another multi-year transition. Some git-annex-shell fields were able to be removed. I hoped to remove all of them, and the very concept of them, but unfortunately autoinit is used by git-annex sync, and gcrypt uses remoteuuid. The main win here is really in Remote.Git, removing piles of hairy fallback code. Sponsored-by: Luke Shumaker
This commit is contained in:
Joey Hess
parent
5e3fe816ef
commit
7bdc7350a5
16 changed files with 82 additions and 428 deletions
10
CHANGELOG
10
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
|
||||
|
|
|
|||
|
|
@ -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,18 +39,15 @@ 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
|
||||
[ gitAnnexShellCheck Command.DropKey.cmd
|
||||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
||||
|
|
|
|||
|
|
@ -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 []
|
||||
|
|
@ -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."
|
||||
|
|
@ -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,
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -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"
|
||||
|
|
|
|||
177
Remote/Git.hs
177
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
|
||||
|
|
@ -820,21 +683,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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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]]
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in a new issue