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.

4 files changed, 65 insertions, 2 deletions

diff --git a/Assistant/Threads/Transferrer.hs b/Assistant/Threads/Transferrer.hs
index 8118a3f3c..cb6f642bf 100644
--- a/Assistant/Threads/Transferrer.hs
+++ b/Assistant/Threads/Transferrer.hs
@@ -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
 					]
diff --git a/Command/TransferKey.hs b/Command/TransferKey.hs
new file mode 100644
index 000000000..1af95f170
--- /dev/null
+++ b/Command/TransferKey.hs
@@ -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
diff --git a/GitAnnex.hs b/GitAnnex.hs
index ce7a41a40..67aead173 100644
--- a/GitAnnex.hs
+++ b/GitAnnex.hs
@@ -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
diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn
index 02cf298c0..48e4f24ea 100644
--- a/doc/git-annex.mdwn
+++ b/doc/git-annex.mdwn
@@ -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