add transferkey command
Used by the assistant, rather than copy, this is faster because it avoids using git ls-files, avoids checking the location log redundantly, and runs in oneshot mode, avoiding making a commit to the git-annex branch for every file transferred.
This commit is contained in:
parent
ab5e409a95
commit
8de7699f39
4 changed files with 65 additions and 2 deletions
|
@ -17,6 +17,7 @@ import Logs.Transfer
|
|||
import Logs.Location
|
||||
import Annex.Content
|
||||
import qualified Remote
|
||||
import Types.Key
|
||||
|
||||
import System.Process (create_group)
|
||||
|
||||
|
@ -101,11 +102,12 @@ transferThread dstatus slots t info runner = case (transferRemote info, associat
|
|||
where
|
||||
command = "git-annex"
|
||||
params =
|
||||
[ Param "copy"
|
||||
, Param "--fast"
|
||||
[ Param "transferkey"
|
||||
, Param $ key2file $ transferKey t
|
||||
, Param $ if isdownload
|
||||
then "--from"
|
||||
else "--to"
|
||||
, Param $ Remote.name remote
|
||||
, Param "--file"
|
||||
, File file
|
||||
]
|
||||
|
|
55
Command/TransferKey.hs
Normal file
55
Command/TransferKey.hs
Normal file
|
@ -0,0 +1,55 @@
|
|||
{- git-annex command, used internally by assistant
|
||||
-
|
||||
- Copyright 2012 Joey Hess <joey@kitenet.net>
|
||||
-
|
||||
- Licensed under the GNU GPL version 3 or higher.
|
||||
-}
|
||||
|
||||
module Command.TransferKey where
|
||||
|
||||
import Common.Annex
|
||||
import Command
|
||||
import Annex.Content
|
||||
import Logs.Location
|
||||
import Logs.Transfer
|
||||
import qualified Remote
|
||||
import Types.Remote
|
||||
import qualified Command.Move
|
||||
import qualified Option
|
||||
|
||||
def :: [Command]
|
||||
def = [withOptions options $
|
||||
oneShot $ command "transferkey" paramKey seek
|
||||
"transfers a key from or to a remote"]
|
||||
|
||||
options :: [Option]
|
||||
options = fileOption : Command.Move.options
|
||||
|
||||
fileOption :: Option
|
||||
fileOption = Option.field [] "file" paramFile "the associated file"
|
||||
|
||||
seek :: [CommandSeek]
|
||||
seek = [withField Command.Move.toOption Remote.byName $ \to ->
|
||||
withField Command.Move.fromOption Remote.byName $ \from ->
|
||||
withField fileOption return $ \file ->
|
||||
withKeys $ start to from file]
|
||||
|
||||
start :: Maybe Remote -> Maybe Remote -> AssociatedFile -> Key -> CommandStart
|
||||
start to from file key =
|
||||
case (from, to) of
|
||||
(Nothing, Just dest) -> next $ toPerform dest key file
|
||||
(Just src, Nothing) -> next $ fromPerform src key file
|
||||
_ -> error "specify either --from or --to"
|
||||
|
||||
toPerform :: Remote -> Key -> AssociatedFile -> CommandPerform
|
||||
toPerform remote key file = next $
|
||||
upload (uuid remote) key file $ do
|
||||
ok <- Remote.storeKey remote key file
|
||||
when ok $
|
||||
Remote.logStatus remote key InfoPresent
|
||||
return ok
|
||||
|
||||
fromPerform :: Remote -> Key -> AssociatedFile -> CommandPerform
|
||||
fromPerform remote key file = next $
|
||||
download (uuid remote) key file $
|
||||
getViaTmp key $ Remote.retrieveKeyFile remote key file
|
|
@ -30,6 +30,7 @@ import qualified Command.Copy
|
|||
import qualified Command.Get
|
||||
import qualified Command.FromKey
|
||||
import qualified Command.DropKey
|
||||
import qualified Command.TransferKey
|
||||
import qualified Command.ReKey
|
||||
import qualified Command.Reinject
|
||||
import qualified Command.Fix
|
||||
|
@ -93,6 +94,7 @@ cmds = concat
|
|||
, Command.Dead.def
|
||||
, Command.FromKey.def
|
||||
, Command.DropKey.def
|
||||
, Command.TransferKey.def
|
||||
, Command.ReKey.def
|
||||
, Command.Fix.def
|
||||
, Command.Fsck.def
|
||||
|
|
|
@ -443,6 +443,10 @@ subdirectories).
|
|||
|
||||
git annex dropkey SHA1-s10-7da006579dd64330eb2456001fd01948430572f2
|
||||
|
||||
* transferkey key
|
||||
|
||||
This plumbing-level command is used by the assistant to transfer data.
|
||||
|
||||
* rekey [file key ...]
|
||||
|
||||
This plumbing-level command is similar to migrate, but you specify
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue