Merge branch 'p2pflagday'
This commit is contained in:
Joey Hess
commit
e43aaa22be
16 changed files with 85 additions and 431 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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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