summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Backend.hs8
-rw-r--r--Backend/File.hs25
-rw-r--r--Backend/URL.hs10
-rw-r--r--Command.hs16
-rw-r--r--Command/Drop.hs17
-rw-r--r--Command/DropUnused.hs4
-rw-r--r--Command/Fsck.hs17
-rw-r--r--Command/FsckFile.hs29
-rw-r--r--Command/Unannex.hs3
-rw-r--r--TypeInternals.hs9
-rw-r--r--Utility.hs9
-rw-r--r--debian/changelog2
-rw-r--r--doc/copies.mdwn7
-rw-r--r--doc/git-annex.mdwn6
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: