dead --key: Can be used to mark a key as dead.

6 files changed, 79 insertions, 20 deletions

diff --git a/CmdLine/GitAnnex/Options.hs b/CmdLine/GitAnnex/Options.hs
index 64435c2e9..46d593618 100644
--- a/CmdLine/GitAnnex/Options.hs
+++ b/CmdLine/GitAnnex/Options.hs
@@ -58,10 +58,13 @@ keyOptions =
 		"operate on all versions of all files"
 	, Option ['U'] ["unused"] (NoArg (Annex.setFlag "unused"))
 		"operate on files found by last run of git-annex unused"
-	, Option [] ["key"] (ReqArg (Annex.setField "key") paramKey)
-		"operate on specified key"
+	, keyOption
 	]
 
+keyOption :: Option
+keyOption = Option [] ["key"] (ReqArg (Annex.setField "key") paramKey)
+		"operate on specified key"
+
 incompleteOption :: Option
 incompleteOption = flagOption [] "incomplete" "resume previous downloads"
 
diff --git a/Command/Dead.hs b/Command/Dead.hs
index 464db25f9..7e62b6db0 100644
--- a/Command/Dead.hs
+++ b/Command/Dead.hs
@@ -1,6 +1,6 @@
 {- git-annex command
  -
- - Copyright 2011 Joey Hess <id@joeyh.name>
+ - Copyright 2011, 2015 Joey Hess <id@joeyh.name>
  -
  - Licensed under the GNU GPL version 3 or higher.
  -}
@@ -8,12 +8,37 @@
 module Command.Dead where
 
 import Command
+import Common.Annex
+import qualified Annex
 import Types.TrustLevel
+import Types.Key
 import Command.Trust (trustCommand)
+import Logs.Location
+import Remote (keyLocations)
 
 cmd :: [Command]
-cmd = [command "dead" (paramRepeating paramRemote) seek
-	SectionSetup "hide a lost repository"]
+cmd = [withOptions [keyOption] $ 
+	command "dead" (paramRepeating paramRemote) seek
+		SectionSetup "hide a lost repository or key"]
 
 seek :: CommandSeek
-seek = trustCommand "dead" DeadTrusted
+seek ps = maybe (trustCommand "dead" DeadTrusted ps) (flip seekKey ps)
+	=<< Annex.getField "key"
+
+seekKey :: String -> CommandSeek
+seekKey ks = case file2key ks of
+	Nothing -> error "Invalid key"
+	Just key -> withNothing (startKey key)
+
+startKey :: Key -> CommandStart
+startKey key = do
+	showStart "dead" (key2file key)
+	ls <- keyLocations key
+	case ls of
+		[] -> next $ performKey key
+		_ -> error "This key is still known to be present in some locations; not marking as dead."
+		
+performKey :: Key -> CommandPerform
+performKey key = do
+	setDead key
+	next $ return True
diff --git a/Logs/Location.hs b/Logs/Location.hs
index 5ad0ae4d0..ba9c31abf 100644
--- a/Logs/Location.hs
+++ b/Logs/Location.hs
@@ -33,6 +33,8 @@ import Annex.UUID
 import Git.Types (RefDate)
 import qualified Annex
 
+import Data.Time.Clock
+
 {- Log a change in the presence of a key's value in current repository. -}
 logStatus :: Key -> LogStatus -> Annex ()
 logStatus key s = do
@@ -71,10 +73,27 @@ checkDead key = do
 	ls <- compactLog <$> readLog (locationLogFile config key)
 	return $ all (\l -> status l == InfoDead) ls
 
-{- Updates the log to say that a key is dead. This changes all logged lines
- - for the key, in any location, to be InfoDead. -}
+{- Updates the log to say that a key is dead. 
+ - 
+ - Changes all logged lines for the key, in any location, that are
+ - currently InfoMissing, to be InfoDead.
+ -}
 setDead :: Key -> Annex ()
-setDead key = undefined
+setDead key = do
+	config <- Annex.getGitConfig
+	let logfile = locationLogFile config key
+	ls <- compactLog <$> readLog logfile
+	mapM_ (go logfile) (filter (\l -> status l == InfoMissing) ls)
+  where
+	go logfile l = addLog logfile $ setDead' l
+
+{- Note that the timestamp in the log is updated minimally, so that this
+ - can be overruled by other location log changes. -}
+setDead' :: LogLine -> LogLine
+setDead' l = l
+	{ status = InfoDead
+	, date = date l + realToFrac (picosecondsToDiffTime 1)
+	}
 
 {- Finds all keys that have location log information.
  - (There may be duplicate keys in the list.) -}
diff --git a/debian/changelog b/debian/changelog
index a1faa0d88..1a7fdb1ee 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -19,6 +19,7 @@ git-annex (5.20150529) UNRELEASED; urgency=medium
   * fsck: Ignore keys that are known to be dead when running in --all mode
     or a in a bare repo. Otherwise, still reports files with lost contents,
     even if the content is dead.
+  * dead --key: Can be used to mark a key as dead.
 
  -- Joey Hess <id@joeyh.name>  Sat, 30 May 2015 02:07:18 -0400
 
diff --git a/doc/git-annex-dead.mdwn b/doc/git-annex-dead.mdwn
index 680d8bba2..804bb419a 100644
--- a/doc/git-annex-dead.mdwn
+++ b/doc/git-annex-dead.mdwn
@@ -1,18 +1,25 @@
 # NAME
 
-git-annex trust - hide a lost repository
+git-annex dead - hide a lost repository or key
 
 # SYNOPSIS
 
-git annex dead `[repository ...]`
+git annex dead `[repository ...] [--key key]`
 
 # DESCRIPTION
 
-Indicates that the repository has been irretrievably lost.
-(To undo, use semitrust.)
+This command exists to deal with situations where data has been lost,
+and you know it has, and you want to stop being reminded of that fact.
 
+When a repository is specified, indicates that the repository has
+been irretrievably lost, so it will not be listed in eg, `git annex info`.
 Repositories can be specified using their remote name, their
-description, or their UUID.
+description, or their UUID. (To undo, use `git-annex semitrust`.)
+
+When a key is specified, indicates that the content of that key has been
+irretrievably lost. This prevents `git annex fsck --all` from complaining
+about it. (To undo, add the key's content back to the repository,
+by using eg, `git-annex reinject`.)
 
 # SEE ALSO
 
@@ -26,6 +33,10 @@ description, or their UUID.
 
 [[git-annex-expire]](1)
 
+[[git-annex-fsck]](1)
+
+[[git-annex-reinject]](1)
+
 # AUTHOR
 
 Joey Hess <id@joeyh.name>
diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn
index 64f70f792..e7c80f3cd 100644
--- a/doc/git-annex.mdwn
+++ b/doc/git-annex.mdwn
@@ -238,12 +238,6 @@ subdirectories).
   
   See [[git-annex-semitrust]](1) for details.
 
-* `dead [repository ...]`
-
-  Indicates that the repository has been irretrievably lost.
-  
-  See [[git-annex-dead]](1) for details.
-
 * `group repository groupname`
 
   Add a repository to a group.
@@ -356,6 +350,12 @@ subdirectories).
   
   See [[git-annex-upgrade]](1) for details.
 
+* `dead [repository ...] [--key key]`
+
+  Indicates that a repository or a single key has been irretrievably lost.
+  
+  See [[git-annex-dead]](1) for details.
+
 * `forget`
 
   Causes the git-annex branch to be rewritten, throwing away historical