b14ec45aa8
This is a nearly free feature; it piggybacks on the location log lookups done for the numcopies stats. So, the only extra overhead is updating the map of repository sizes. However, I had to switch to Data.Map.Strict, which needs containers 0.5. If backporting to wheezy, will probably need to revert this commit.
85 lines
2.5 KiB
Haskell
85 lines
2.5 KiB
Haskell
{- git-annex numcopies configuration
|
|
-
|
|
- Copyright 2014 Joey Hess <id@joeyh.name>
|
|
-
|
|
- Licensed under the GNU GPL version 3 or higher.
|
|
-}
|
|
|
|
module Config.NumCopies (
|
|
module Types.NumCopies,
|
|
module Logs.NumCopies,
|
|
getFileNumCopies,
|
|
getGlobalFileNumCopies,
|
|
getNumCopies,
|
|
deprecatedNumCopies,
|
|
defaultNumCopies,
|
|
numCopiesCheck,
|
|
numCopiesCheck',
|
|
) where
|
|
|
|
import Common.Annex
|
|
import qualified Annex
|
|
import Types.NumCopies
|
|
import Logs.NumCopies
|
|
import Logs.Trust
|
|
import Annex.CheckAttr
|
|
import qualified Remote
|
|
|
|
defaultNumCopies :: NumCopies
|
|
defaultNumCopies = NumCopies 1
|
|
|
|
fromSources :: [Annex (Maybe NumCopies)] -> Annex NumCopies
|
|
fromSources = fromMaybe defaultNumCopies <$$> getM id
|
|
|
|
{- The git config annex.numcopies is deprecated. -}
|
|
deprecatedNumCopies :: Annex (Maybe NumCopies)
|
|
deprecatedNumCopies = annexNumCopies <$> Annex.getGitConfig
|
|
|
|
{- Value forced on the command line by --numcopies. -}
|
|
getForcedNumCopies :: Annex (Maybe NumCopies)
|
|
getForcedNumCopies = Annex.getState Annex.forcenumcopies
|
|
|
|
{- Numcopies value from any of the non-.gitattributes configuration
|
|
- sources. -}
|
|
getNumCopies :: Annex NumCopies
|
|
getNumCopies = fromSources
|
|
[ getForcedNumCopies
|
|
, getGlobalNumCopies
|
|
, deprecatedNumCopies
|
|
]
|
|
|
|
{- Numcopies value for a file, from any configuration source, including the
|
|
- deprecated git config. -}
|
|
getFileNumCopies :: FilePath -> Annex NumCopies
|
|
getFileNumCopies f = fromSources
|
|
[ getForcedNumCopies
|
|
, getFileNumCopies' f
|
|
, deprecatedNumCopies
|
|
]
|
|
|
|
{- This is the globally visible numcopies value for a file. So it does
|
|
- not include local configuration in the git config or command line
|
|
- options. -}
|
|
getGlobalFileNumCopies :: FilePath -> Annex NumCopies
|
|
getGlobalFileNumCopies f = fromSources
|
|
[ getFileNumCopies' f
|
|
]
|
|
|
|
getFileNumCopies' :: FilePath -> Annex (Maybe NumCopies)
|
|
getFileNumCopies' file = maybe getGlobalNumCopies (return . Just) =<< getattr
|
|
where
|
|
getattr = (NumCopies <$$> readish)
|
|
<$> checkAttr "annex.numcopies" file
|
|
|
|
{- Checks if numcopies are satisfied for a file by running a comparison
|
|
- between the number of (not untrusted) copies that are
|
|
- belived to exist, and the configured value. -}
|
|
numCopiesCheck :: FilePath -> Key -> (Int -> Int -> v) -> Annex v
|
|
numCopiesCheck file key vs = do
|
|
have <- trustExclude UnTrusted =<< Remote.keyLocations key
|
|
numCopiesCheck' file vs have
|
|
|
|
numCopiesCheck' :: FilePath -> (Int -> Int -> v) -> [UUID] -> Annex v
|
|
numCopiesCheck' file vs have = do
|
|
NumCopies needed <- getFileNumCopies file
|
|
return $ length have `vs` needed
|