From 5d6c7bccb3037633dc3360dcc22639adb5fe5793 Mon Sep 17 00:00:00 2001
From: Joey Hess <joeyh@joeyh.name>
Date: Thu, 2 Jul 2015 17:44:25 -0400
Subject: Brought back the setkey plumbing command that was removed in 2011,
 since we found a use case for it. Note that the command's syntax was changed
 for consistency.

---
 Command/SetKey.hs | 49 +++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 49 insertions(+)
 create mode 100644 Command/SetKey.hs

(limited to 'Command/SetKey.hs')

diff --git a/Command/SetKey.hs b/Command/SetKey.hs
new file mode 100644
index 000000000..02118fb14
--- /dev/null
+++ b/Command/SetKey.hs
@@ -0,0 +1,49 @@
+{- git-annex command
+ -
+ - Copyright 2010, 2015 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.SetKey where
+
+import Common.Annex
+import Command
+import Logs.Location
+import Annex.Content
+import Types.Key
+
+cmd :: [Command]
+cmd = [command "setkey" (paramPair paramKey paramPath) seek
+	SectionPlumbing "sets annexed content for a key"]
+
+seek :: CommandSeek
+seek = withWords start
+
+start :: [String] -> CommandStart
+start (keyname:file:[]) = do
+	showStart "setkey" file
+	next $ perform file (mkKey keyname)
+start _ = error "specify a key and a content file"
+
+mkKey :: String -> Key
+mkKey = fromMaybe (error "bad key") . file2key
+
+perform :: FilePath -> Key -> CommandPerform
+perform file key = do
+	-- the file might be on a different filesystem, so mv is used
+	-- rather than simply calling moveAnnex; disk space is also
+	-- checked this way.
+	ok <- getViaTmp key $ \dest ->
+		if dest /= file
+			then liftIO $
+				boolSystem "mv" [File file, File dest]
+		else return True
+	if ok
+		then next $ cleanup key
+		else error "mv failed!"
+
+cleanup :: Key -> CommandCleanup
+cleanup key = do
+	logStatus key InfoPresent
+	return True
-- 
cgit v1.2.3