7bdc7350a5
* 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
63 lines
1.8 KiB
Haskell
63 lines
1.8 KiB
Haskell
{- git-annex command
|
|
-
|
|
- Copyright 2010,2012 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU AGPL version 3 or higher.
|
|
-}
|
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
module Command.SendKey where
|
|
|
|
import Command
|
|
import Annex.Content
|
|
import Annex
|
|
import Utility.Rsync
|
|
import Annex.Transfer
|
|
import qualified CmdLine.GitAnnexShell.Fields as Fields
|
|
import Utility.Metered
|
|
|
|
cmd :: Command
|
|
cmd = noCommit $
|
|
command "sendkey" SectionPlumbing
|
|
"runs rsync in server mode to send content"
|
|
paramKey (withParams seek)
|
|
|
|
seek :: CmdParams -> CommandSeek
|
|
seek = withKeys (commandAction . start)
|
|
|
|
start :: (SeekInput, Key) -> CommandStart
|
|
start (_, key) = do
|
|
opts <- filterRsyncSafeOptions . maybe [] words
|
|
<$> getField "RsyncOptions"
|
|
ifM (inAnnex key)
|
|
( fieldTransfer Upload key $ \_p ->
|
|
sendAnnex key rollback $ liftIO . rsyncServerSend (map Param opts)
|
|
, do
|
|
warning "requested key is not present"
|
|
liftIO exitFailure
|
|
)
|
|
where
|
|
{- No need to do any rollback; when sendAnnex fails, a nonzero
|
|
- exit will be propigated, and the remote will know the transfer
|
|
- failed. -}
|
|
rollback = noop
|
|
|
|
fieldTransfer :: Direction -> Key -> (MeterUpdate -> Annex Bool) -> CommandStart
|
|
fieldTransfer direction key a = do
|
|
fastDebug "Command.SendKey" "transfer start"
|
|
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)
|
|
=<< Fields.getField Fields.remoteUUID
|
|
fastDebug "Command.SendKey" "transfer done"
|
|
liftIO $ exitBool ok
|
|
where
|
|
{- Allow the key to be sent to the remote even if there seems to be
|
|
- another transfer of that key going on to that remote.
|
|
- That one may be stale, etc.
|
|
-}
|
|
runner
|
|
| direction == Upload = alwaysRunTransfer
|
|
| otherwise = runTransfer
|