In .gitattributes, the git-annex-numcopies attribute can be used to control the number of copies to retain of different types of files.

14 files changed, 87 insertions, 75 deletions

diff --git a/Backend.hs b/Backend.hs
index d5d8efa03..8e17f253f 100644
--- a/Backend.hs
+++ b/Backend.hs
@@ -104,8 +104,8 @@ retrieveKeyFile :: Backend -> Key -> FilePath -> Annex Bool
 retrieveKeyFile backend key dest = (Internals.retrieveKeyFile backend) key dest
 
 {- Removes a key from a backend. -}
-removeKey :: Backend -> Key -> Annex Bool
-removeKey backend key = (Internals.removeKey backend) key
+removeKey :: Backend -> Key -> Maybe Int -> Annex Bool
+removeKey backend key numcopies = (Internals.removeKey backend) key numcopies
 
 {- Checks if a key is present in its backend. -}
 hasKey :: Key -> Annex Bool
@@ -114,8 +114,8 @@ hasKey key = do
 	(Internals.hasKey backend) key
 
 {- Checks a key's backend for problems. -}
-fsckKey :: Backend -> Key -> Annex Bool
-fsckKey backend key = (Internals.fsckKey backend) key
+fsckKey :: Backend -> Key -> Maybe Int -> Annex Bool
+fsckKey backend key numcopies = (Internals.fsckKey backend) key numcopies
 
 {- Looks up the key and backend corresponding to an annexed file,
  - by examining what the file symlinks to. -}
diff --git a/Backend/File.hs b/Backend/File.hs
index c0fc46992..5984348b3 100644
--- a/Backend/File.hs
+++ b/Backend/File.hs
@@ -86,14 +86,14 @@ copyKeyFile key file = do
 {- Checks remotes to verify that enough copies of a key exist to allow
  - for a key to be safely removed (with no data loss), and fails with an
  - error if not. -}
-checkRemoveKey :: Key -> Annex Bool
-checkRemoveKey key = do
+checkRemoveKey :: Key -> Maybe Int -> Annex Bool
+checkRemoveKey key numcopiesM = do
 	force <- Annex.flagIsSet "force"
-	if force
+	if force || numcopiesM == Just 0
 		then return True
 		else do
 			remotes <- Remotes.keyPossibilities key
-			numcopies <- getNumCopies
+			numcopies <- getNumCopies numcopiesM
 			if numcopies > length remotes
 				then notEnoughCopies numcopies (length remotes) []
 				else findcopies numcopies 0 remotes []
@@ -139,8 +139,9 @@ showTriedRemotes remotes =
 	showLongNote $ "I was unable to access these remotes: " ++
 		Remotes.list remotes
 
-getNumCopies :: Annex Int
-getNumCopies = do
+getNumCopies :: Maybe Int -> Annex Int
+getNumCopies (Just n) = return n
+getNumCopies Nothing = do
 	g <- Annex.gitRepo
 	return $ read $ Git.configGet g config "1"
 	where
@@ -153,15 +154,15 @@ getNumCopies = do
  - The passed action is first run to allow backends deriving this one
  - to do their own checks.
  -}
-checkKey :: (Key -> Annex Bool) -> Key -> Annex Bool
-checkKey a key = do
+checkKey :: (Key -> Annex Bool) -> Key -> Maybe Int -> Annex Bool
+checkKey a key numcopies = do
 	a_ok <- a key
-	copies_ok <- checkKeyNumCopies key
+	copies_ok <- checkKeyNumCopies key numcopies
 	return $ a_ok && copies_ok
 
-checkKeyNumCopies :: Key -> Annex Bool
-checkKeyNumCopies key = do
-	needed <- getNumCopies
+checkKeyNumCopies :: Key -> Maybe Int -> Annex Bool
+checkKeyNumCopies key numcopies = do
+	needed <- getNumCopies numcopies
 	remotes <- Remotes.keyPossibilities key
 	inannex <- inAnnex key
 	let present = length remotes + if inannex then 1 else 0
diff --git a/Backend/URL.hs b/Backend/URL.hs
index b38ea71c9..3eb7376e0 100644
--- a/Backend/URL.hs
+++ b/Backend/URL.hs
@@ -22,11 +22,11 @@ backend = Backend {
 	retrieveKeyFile = downloadUrl,
 	-- allow keys to be removed; presumably they can always be
 	-- downloaded again
-	removeKey = dummyOk,
+	removeKey = dummyRemove,
 	-- similarly, keys are always assumed to be out there on the web
 	hasKey = dummyOk,
 	-- and nothing needed to fsck
-	fsckKey = dummyOk
+	fsckKey = dummyFsck
 }
 
 -- cannot generate url from filename
@@ -37,6 +37,12 @@ keyValue _ = return Nothing
 dummyStore :: FilePath -> Key -> Annex Bool
 dummyStore _ _ = return False
 
+dummyRemove :: Key -> Maybe a -> Annex Bool
+dummyRemove _ _ = return False
+
+dummyFsck :: Key -> Maybe a -> Annex Bool
+dummyFsck _ _ = return True
+
 dummyOk :: Key -> Annex Bool
 dummyOk _ = return True
 
diff --git a/Command.hs b/Command.hs
index 7f3063abb..059b6e435 100644
--- a/Command.hs
+++ b/Command.hs
@@ -44,6 +44,9 @@ type SubCmdStartString = String -> SubCmdStart
 type BackendFile = (FilePath, Maybe Backend)
 type SubCmdSeekBackendFiles = SubCmdStartBackendFile -> SubCmdSeek
 type SubCmdStartBackendFile = BackendFile -> SubCmdStart
+type AttrFile = (FilePath, String)
+type SubCmdSeekAttrFiles = SubCmdStartAttrFile -> SubCmdSeek
+type SubCmdStartAttrFile = AttrFile -> SubCmdStart
 type SubCmdSeekNothing = SubCmdStart -> SubCmdSeek
 type SubCmdStartNothing = SubCmdStart
 
@@ -104,6 +107,13 @@ withFilesInGit a params = do
 	repo <- Annex.gitRepo
 	files <- liftIO $ mapM (Git.inRepo repo) params
 	return $ map a $ filter notState $ foldl (++) [] files
+withAttrFilesInGit :: String -> SubCmdSeekAttrFiles
+withAttrFilesInGit attr a params = do
+	repo <- Annex.gitRepo
+	files <- liftIO $ mapM (Git.inRepo repo) params
+	pairs <- liftIO $ Git.checkAttr repo attr $
+		filter notState $ foldl (++) [] files
+	return $ map a pairs
 withFilesMissing :: SubCmdSeekStrings
 withFilesMissing a params = do
 	files <- liftIO $ filterM missing params
@@ -152,21 +162,21 @@ backendPairs a files = do
 
 {- Default to acting on all files matching the seek action if
  - none are specified. -}
-withAll :: SubCmdSeekStrings -> SubCmdSeekStrings
+withAll :: (a -> SubCmdSeek) -> a -> SubCmdSeek
 withAll w a [] = do
 	g <- Annex.gitRepo
 	w a [Git.workTree g]
 withAll w a p = w a p
 
 {- Provides a default parameter to act on if none is specified. -}
-withDefault :: String-> SubCmdSeekStrings -> SubCmdSeekStrings
+withDefault :: String-> (a -> SubCmdSeek) -> (a -> SubCmdSeek)
 withDefault d w a [] = w a [d]
 withDefault _ w a p = w a p
 
 {- filter out files from the state directory -}
 notState :: FilePath -> Bool
 notState f = stateLoc /= take (length stateLoc) f
-	
+
 {- filter out symlinks -}	
 notSymlink :: FilePath -> IO Bool
 notSymlink f = do
diff --git a/Command/Drop.hs b/Command/Drop.hs
index fbe66f584..168aa92bd 100644
--- a/Command/Drop.hs
+++ b/Command/Drop.hs
@@ -15,24 +15,27 @@ import LocationLog
 import Types
 import Core
 import Messages
+import Utility
 
 seek :: [SubCmdSeek]
-seek = [withFilesInGit start]
+seek = [withAttrFilesInGit "git-annex-numcopies" start]
 
 {- Indicates a file's content is not wanted anymore, and should be removed
  - if it's safe to do so. -}
-start :: SubCmdStartString
-start file = isAnnexed file $ \(key, backend) -> do
+start :: SubCmdStartAttrFile
+start (file, attr) = isAnnexed file $ \(key, backend) -> do
 	inbackend <- Backend.hasKey key
 	if not inbackend
 		then return Nothing
 		else do
 			showStart "drop" file
-			return $ Just $ perform key backend
+			return $ Just $ perform key backend numcopies
+	where
+		numcopies = readMaybe attr :: Maybe Int
 
-perform :: Key -> Backend -> SubCmdPerform
-perform key backend = do
-	success <- Backend.removeKey backend key
+perform :: Key -> Backend -> Maybe Int -> SubCmdPerform
+perform key backend numcopies = do
+	success <- Backend.removeKey backend key numcopies
 	if success
 		then return $ Just $ cleanup key
 		else return Nothing
diff --git a/Command/DropUnused.hs b/Command/DropUnused.hs
index e8b8d43c4..016a9faa7 100644
--- a/Command/DropUnused.hs
+++ b/Command/DropUnused.hs
@@ -30,9 +30,7 @@ start s = do
 		Just key -> do
 			showStart "dropunused" s
 			backend <- keyBackend key
-			-- force drop, even if this is the only copy
-			Annex.flagChange "force" $ FlagBool True
-			return $ Just $ Command.Drop.perform key backend
+			return $ Just $ Command.Drop.perform key backend (Just 0)
 
 readUnusedLog :: Annex (M.Map String Key)
 readUnusedLog = do
diff --git a/Command/Fsck.hs b/Command/Fsck.hs
index dc0168801..4341f85cd 100644
--- a/Command/Fsck.hs
+++ b/Command/Fsck.hs
@@ -11,19 +11,22 @@ import Command
 import qualified Backend
 import Types
 import Messages
+import Utility
 
 seek :: [SubCmdSeek]
-seek = [withAll withFilesInGit start]
+seek = [withAll (withAttrFilesInGit "git-annex-numcopies") start]
 
 {- Checks a file's backend data for problems. -}
-start :: SubCmdStartString
-start file = isAnnexed file $ \(key, backend) -> do
+start :: SubCmdStartAttrFile
+start (file, attr) = isAnnexed file $ \(key, backend) -> do
 	showStart "fsck" file
-	return $ Just $ perform key backend
+	return $ Just $ perform key backend numcopies
+	where
+		numcopies = readMaybe attr :: Maybe Int
 
-perform :: Key -> Backend -> SubCmdPerform
-perform key backend = do
-	success <- Backend.fsckKey backend key
+perform :: Key -> Backend -> Maybe Int -> SubCmdPerform
+perform key backend numcopies = do
+	success <- Backend.fsckKey backend key numcopies
 	if success
 		then return $ Just $ return True
 		else return Nothing
diff --git a/Command/FsckFile.hs b/Command/FsckFile.hs
deleted file mode 100644
index e7c3d4915..000000000
--- a/Command/FsckFile.hs
+++ /dev/null
@@ -1,29 +0,0 @@
-{- git-annex command
- -
- - Copyright 2010 Joey Hess <joey@kitenet.net>
- -
- - Licensed under the GNU GPL version 3 or higher.
- -}
-
-module Command.FsckFile where
-
-import Command
-import qualified Backend
-import Types
-import Messages
-
-seek :: [SubCmdSeek]
-seek = [withFilesInGit start]
-
-{- Checks a file's backend data for problems. -}
-start :: SubCmdStartString
-start file = isAnnexed file $ \(key, backend) -> do
-	showStart "fsck" file
-	return $ Just $ perform key backend
-
-perform :: Key -> Backend -> SubCmdPerform
-perform key backend = do
-	success <- Backend.fsckKey backend key
-	if success
-		then return $ Just $ return True
-		else return Nothing
diff --git a/Command/Unannex.hs b/Command/Unannex.hs
index 90ae55058..9580fc5e7 100644
--- a/Command/Unannex.hs
+++ b/Command/Unannex.hs
@@ -32,8 +32,7 @@ start file = isAnnexed file $ \(key, backend) -> do
 perform :: FilePath -> Key -> Backend -> SubCmdPerform
 perform file key backend = do
 	-- force backend to always remove
-	Annex.flagChange "force" $ FlagBool True
-	ok <- Backend.removeKey backend key
+	ok <- Backend.removeKey backend key (Just 0)
 	if ok
 		then return $ Just $ cleanup file key
 		else return Nothing
diff --git a/TypeInternals.hs b/TypeInternals.hs
index bcef4ee0a..9acc06bb3 100644
--- a/TypeInternals.hs
+++ b/TypeInternals.hs
@@ -72,12 +72,15 @@ data Backend = Backend {
 	storeFileKey :: FilePath -> Key -> Annex Bool,
 	-- retrieves a key's contents to a file
 	retrieveKeyFile :: Key -> FilePath -> Annex Bool,
-	-- removes a key
-	removeKey :: Key -> Annex Bool,
+	-- removes a key, optionally checking that enough copies are stored
+	-- elsewhere
+	removeKey :: Key -> Maybe Int -> Annex Bool,
 	-- checks if a backend is storing the content of a key
 	hasKey :: Key -> Annex Bool,
 	-- called during fsck to check a key
-	fsckKey :: Key -> Annex Bool
+	-- (second parameter may be the number of copies that there should
+	-- be of the key)
+	fsckKey :: Key -> Maybe Int -> Annex Bool
 }
 
 instance Show Backend where
diff --git a/Utility.hs b/Utility.hs
index 2bea6e875..882492a2d 100644
--- a/Utility.hs
+++ b/Utility.hs
@@ -12,7 +12,8 @@ module Utility (
 	relPathDirToDir,
 	boolSystem,
 	shellEscape,
-	unsetFileMode
+	unsetFileMode,
+	readMaybe
 ) where
 
 import System.IO
@@ -125,3 +126,9 @@ unsetFileMode :: FilePath -> FileMode -> IO ()
 unsetFileMode f m = do
 	s <- getFileStatus f
 	setFileMode f $ fileMode s `intersectFileModes` complement m
+
+{- Attempts to read a value from a String. -}
+readMaybe :: (Read a) => String -> Maybe a
+readMaybe s = case reads s of
+	((x,_):_) -> Just x
+	_ -> Nothing
diff --git a/debian/changelog b/debian/changelog
index 808087dad..213895c5f 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,6 +1,8 @@
 git-annex (0.10) UNRELEASED; urgency=low
 
   * precommit: Optimise to avoid calling git-check-attr more than once.
+  * In .gitattributes, the git-annex-numcopies attribute can be used
+    to control the number of copies to retain of different types of files.
 
  -- Joey Hess <joeyh@debian.org>  Sun, 28 Nov 2010 14:19:15 -0400
 
diff --git a/doc/copies.mdwn b/doc/copies.mdwn
index aec10ab7a..f647ea622 100644
--- a/doc/copies.mdwn
+++ b/doc/copies.mdwn
@@ -3,8 +3,11 @@ your git repository's `.git` directory, not in some external data store.
 
 It's important that data not get lost by an ill-considered `git annex drop`
 command.  So, then using those backends, git-annex can be configured to try
-to keep N copies of a file's content available across all repositories. By
-default, N is 1; it is configured by annex.numcopies.
+to keep N copies of a file's content available across all repositories. 
+
+By default, N is 1; it is configured by annex.numcopies. This default
+can be overridden on a per-file-type basis by the git-annex-numcopies
+setting in the `.gitattributes` file.
 
 `git annex drop` attempts to check with other git remotes, to check that N
 copies of the file exist. If enough repositories cannot be verified to have
diff --git a/doc/git-annex.mdwn b/doc/git-annex.mdwn
index 27393de50..65cce8cc2 100644
--- a/doc/git-annex.mdwn
+++ b/doc/git-annex.mdwn
@@ -275,6 +275,12 @@ but the SHA1 backend for ogg files:
 	* git-annex-backend=WORM
 	*.ogg git-annex-backend=SHA1
 
+The numcopies setting can also be configured on a per-file-type basis via
+the `git-annex-numcopies` attribute. For example, this makes two copies
+be needed for ogg files:
+
+	*.ogg git-annex-numcopies=2
+
 # FILES
 
 These files are used, in your git repository: