From 653ad35a9f728ed5b3e9b557cdfb15a19b4afe16 Mon Sep 17 00:00:00 2001
From: Joey Hess <joey@kitenet.net>
Date: Sun, 28 Nov 2010 15:28:20 -0400
Subject: In .gitattributes, the git-annex-numcopies attribute can be used to
 control the number of copies to retain of different types of files.

---
 Backend/File.hs | 25 +++++++++++++------------
 Backend/URL.hs  | 10 ++++++++--
 2 files changed, 21 insertions(+), 14 deletions(-)

(limited to 'Backend')

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
 
-- 
cgit v1.2.3