diff options
| -rw-r--r-- | Backend.hs | 8 | ||||
| -rw-r--r-- | Backend/File.hs | 25 | ||||
| -rw-r--r-- | Backend/URL.hs | 10 | ||||
| -rw-r--r-- | Command.hs | 16 | ||||
| -rw-r--r-- | Command/Drop.hs | 17 | ||||
| -rw-r--r-- | Command/DropUnused.hs | 4 | ||||
| -rw-r--r-- | Command/Fsck.hs | 17 | ||||
| -rw-r--r-- | Command/FsckFile.hs | 29 | ||||
| -rw-r--r-- | Command/Unannex.hs | 3 | ||||
| -rw-r--r-- | TypeInternals.hs | 9 | ||||
| -rw-r--r-- | Utility.hs | 9 | ||||
| -rw-r--r-- | debian/changelog | 2 | ||||
| -rw-r--r-- | doc/copies.mdwn | 7 | ||||
| -rw-r--r-- | doc/git-annex.mdwn | 6 |
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: |