aboutsummaryrefslogtreecommitdiff
path: root/Command/TransferKey.hs
diff options
context:
space:
mode:
authorGravatar Joey Hess <joeyh@debian.org>2013-08-15 04:14:33 -0400
committerGravatar Joey Hess <joeyh@debian.org>2013-08-15 04:14:33 -0400
commitd93c66f4e9114aba435d3741b17f9e47a53c471b (patch)
treed1a81e2a0809d42fb9a44e2444ba3d4c17797b44 /Command/TransferKey.hs
git-annex (4.20130815) unstable; urgency=low
* assistant, watcher: .gitignore files and other git ignores are now honored, when git 1.8.4 or newer is installed. (Thanks, Adam Spiers, for getting the necessary support into git for this.) * importfeed: Ignores transient problems with feeds. Only exits nonzero when a feed has repeatedly had a problems for at least 1 day. * importfeed: Fix handling of dots in extensions. * Windows: Added support for encrypted special remotes. * Windows: Fixed permissions problem that prevented removing files from directory special remote. Directory special remotes now fully usable. # imported from the archive
Diffstat (limited to 'Command/TransferKey.hs')
-rw-r--r--Command/TransferKey.hs59
1 files changed, 59 insertions, 0 deletions
diff --git a/Command/TransferKey.hs b/Command/TransferKey.hs
new file mode 100644
index 000000000..849cbc12b
--- /dev/null
+++ b/Command/TransferKey.hs
@@ -0,0 +1,59 @@
+{- git-annex command, used internally by old versions of assistant;
+ - kept around for now so running daemons don't break when upgraded
+ -
+ - 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 $
+ noCommit $ command "transferkey" paramKey seek SectionPlumbing
+ "transfers a key from or to a remote"]
+
+options :: [Option]
+options = [fileOption, Command.Move.fromOption, Command.Move.toOption]
+
+fileOption :: Option
+fileOption = Option.field [] "file" paramFile "the associated file"
+
+seek :: [CommandSeek]
+seek = [withField Command.Move.toOption Remote.byNameWithUUID $ \to ->
+ withField Command.Move.fromOption Remote.byNameWithUUID $ \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 = go $
+ upload (uuid remote) key file forwardRetry $ \p -> do
+ ok <- Remote.storeKey remote key file p
+ when ok $
+ Remote.logStatus remote key InfoPresent
+ return ok
+
+fromPerform :: Remote -> Key -> AssociatedFile -> CommandPerform
+fromPerform remote key file = go $
+ download (uuid remote) key file forwardRetry $ \p ->
+ getViaTmp key $ \t -> Remote.retrieveKeyFile remote key file t p
+
+go :: Annex Bool -> CommandPerform
+go a = ifM a ( liftIO exitSuccess, liftIO exitFailure)