setpresentkey: A new plumbing-level command.

5 files changed, 50 insertions, 4 deletions

diff --git a/CmdLine/GitAnnex.hs b/CmdLine/GitAnnex.hs
index 792765dde..6903ea1a8 100644
--- a/CmdLine/GitAnnex.hs
+++ b/CmdLine/GitAnnex.hs
@@ -27,6 +27,7 @@ import qualified Command.FromKey
 import qualified Command.DropKey
 import qualified Command.TransferKey
 import qualified Command.TransferKeys
+import qualified Command.SetPresentKey
 import qualified Command.ReKey
 import qualified Command.MetaData
 import qualified Command.View
@@ -150,6 +151,7 @@ cmds = concat
 	, Command.DropKey.cmd
 	, Command.TransferKey.cmd
 	, Command.TransferKeys.cmd
+	, Command.SetPresentKey.cmd
 	, Command.ReKey.cmd
 	, Command.MetaData.cmd
 	, Command.View.cmd
diff --git a/Command/SetPresentKey.hs b/Command/SetPresentKey.hs
new file mode 100644
index 000000000..94b442e22
--- /dev/null
+++ b/Command/SetPresentKey.hs
@@ -0,0 +1,36 @@
+{- git-annex command
+ -
+ - Copyright 2014 Joey Hess <joey@kitenet.net>
+ -
+ - Licensed under the GNU GPL version 3 or higher.
+ -}
+
+module Command.SetPresentKey where
+
+import Common.Annex
+import Command
+import qualified Annex
+import Logs.Location
+import Logs.Presence.Pure
+import Types.Key
+
+cmd :: [Command]
+cmd = [noCommit $ command "setpresentkey" (paramPair paramKey "[1|0]") seek
+	SectionPlumbing "change records of where key is present"] 
+
+seek :: CommandSeek
+seek = withWords start
+
+start :: [String] -> CommandStart
+start (ks:us:vs:[]) = do
+	showStart' "setpresentkey" k Nothing
+	next $ perform k (toUUID us) status
+  where
+	k = fromMaybe (error "bad key") (file2key ks)
+	status = fromMaybe (error "bad value") (parseStatus vs)
+start _ = error "Wrong number of parameters"
+
+perform :: Key -> UUID -> LogStatus -> CommandPerform
+perform k u status = next $ do
+	logChange k u status
+	return True
diff --git a/Logs/Presence/Pure.hs b/Logs/Presence/Pure.hs
index ffeb78b26..6bf36d883 100644
--- a/Logs/Presence/Pure.hs
+++ b/Logs/Presence/Pure.hs
@@ -30,14 +30,16 @@ parseLog = mapMaybe parseline . lines
   where
 	parseline l = LogLine
 		<$> (utcTimeToPOSIXSeconds <$> parseTime defaultTimeLocale "%s%Qs" d)
-		<*> parsestatus s
+		<*> parseStatus s
 		<*> pure rest
 	  where
 		(d, pastd) = separate (== ' ') l
 		(s, rest) = separate (== ' ') pastd
-	parsestatus "1" = Just InfoPresent
-	parsestatus "0" = Just InfoMissing
-	parsestatus _ = Nothing
+
+parseStatus :: String -> Maybe LogStatus
+parseStatus "1" = Just InfoPresent
+parseStatus "0" = Just InfoMissing
+parseStatus _ = Nothing
 
 {- Generates a log file. -}
 showLog :: [LogLine] -> String
diff --git a/debian/changelog b/debian/changelog
index c476ab86a..cdc53fd95 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -3,6 +3,7 @@ git-annex (5.20141220) UNRELEASED; urgency=medium
   * vicfg: Avoid crashing on badly encoded config data.
   * Work around statfs() overflow on some XFS systems.
   * sync: Now supports remote groups, the same way git remote update does.
+  * setpresentkey: A new plumbing-level command.
 
  -- Joey Hess <id@joeyh.name>  Mon, 22 Dec 2014 15:16:38 -0400
 
diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn
index a6f638de2..ce0311e46 100644
--- a/doc/git-annex.mdwn
+++ b/doc/git-annex.mdwn
@@ -948,6 +948,11 @@ subdirectories).
   stdio protocol, which is intentionally not documented (as it may change
   at any time).
 
+* `setpresentkey key uuid [1|0]`
+
+  This plumbing-level command changes git-annex's records about whether
+  the specified key is present in a remote with the specified uuid.
+
 * `rekey [file key ...]`
 
   This plumbing-level command is similar to migrate, but you specify