Improve behavior when unable to parse a preferred content expression (thanks, ion).
Fall back to "present" as the preferred conent expression, which will not result in any content movement.
This commit is contained in:
parent
9aa31b71f3
commit
ed30b81e2c
4 changed files with 38 additions and 12 deletions
5
Limit.hs
5
Limit.hs
|
@ -120,7 +120,10 @@ addIn s = addLimit =<< mk
|
||||||
|
|
||||||
{- Limit to content that is currently present on a uuid. -}
|
{- Limit to content that is currently present on a uuid. -}
|
||||||
limitPresent :: Maybe UUID -> MkLimit
|
limitPresent :: Maybe UUID -> MkLimit
|
||||||
limitPresent u _ = Right $ const $ checkKey $ \key -> do
|
limitPresent u _ = Right $ matchPresent u
|
||||||
|
|
||||||
|
matchPresent :: Maybe UUID -> MatchFiles
|
||||||
|
matchPresent u _ = checkKey $ \key -> do
|
||||||
hereu <- getUUID
|
hereu <- getUUID
|
||||||
if u == Just hereu || isNothing u
|
if u == Just hereu || isNothing u
|
||||||
then inAnnex key
|
then inAnnex key
|
||||||
|
|
|
@ -37,6 +37,7 @@ import Types.Remote (RemoteConfig)
|
||||||
import Logs.Group
|
import Logs.Group
|
||||||
import Logs.Remote
|
import Logs.Remote
|
||||||
import Types.StandardGroups
|
import Types.StandardGroups
|
||||||
|
import Limit
|
||||||
|
|
||||||
{- Checks if a file is preferred content for the specified repository
|
{- Checks if a file is preferred content for the specified repository
|
||||||
- (or the current repository if none is specified). -}
|
- (or the current repository if none is specified). -}
|
||||||
|
@ -67,29 +68,45 @@ preferredContentMapLoad = do
|
||||||
|
|
||||||
{- This intentionally never fails, even on unparsable expressions,
|
{- This intentionally never fails, even on unparsable expressions,
|
||||||
- because the configuration is shared among repositories and newer
|
- because the configuration is shared among repositories and newer
|
||||||
- versions of git-annex may add new features. Instead, parse errors
|
- versions of git-annex may add new features. -}
|
||||||
- result in a Matcher that will always succeed. -}
|
makeMatcher
|
||||||
makeMatcher :: GroupMap -> M.Map UUID RemoteConfig -> M.Map Group PreferredContentExpression -> UUID -> PreferredContentExpression -> FileMatcher
|
:: GroupMap
|
||||||
|
-> M.Map UUID RemoteConfig
|
||||||
|
-> M.Map Group PreferredContentExpression
|
||||||
|
-> UUID
|
||||||
|
-> PreferredContentExpression
|
||||||
|
-> FileMatcher
|
||||||
makeMatcher groupmap configmap groupwantedmap u = go True True
|
makeMatcher groupmap configmap groupwantedmap u = go True True
|
||||||
where
|
where
|
||||||
go expandstandard expandgroupwanted expr
|
go expandstandard expandgroupwanted expr
|
||||||
| null (lefts tokens) = Utility.Matcher.generate $ rights tokens
|
| null (lefts tokens) = Utility.Matcher.generate $ rights tokens
|
||||||
| otherwise = matchAll
|
| otherwise = unknownMatcher u
|
||||||
where
|
where
|
||||||
tokens = exprParser matchstandard matchgroupwanted groupmap configmap (Just u) expr
|
tokens = exprParser matchstandard matchgroupwanted groupmap configmap (Just u) expr
|
||||||
matchstandard
|
matchstandard
|
||||||
| expandstandard = maybe matchAll (go False False)
|
| expandstandard = maybe (unknownMatcher u) (go False False)
|
||||||
(standardPreferredContent <$> getStandardGroup mygroups)
|
(standardPreferredContent <$> getStandardGroup mygroups)
|
||||||
| otherwise = matchAll
|
| otherwise = unknownMatcher u
|
||||||
matchgroupwanted
|
matchgroupwanted
|
||||||
| expandgroupwanted = maybe matchAll (go True False)
|
| expandgroupwanted = maybe (unknownMatcher u) (go True False)
|
||||||
(groupwanted mygroups)
|
(groupwanted mygroups)
|
||||||
| otherwise = matchAll
|
| otherwise = unknownMatcher u
|
||||||
mygroups = fromMaybe S.empty (u `M.lookup` groupsByUUID groupmap)
|
mygroups = fromMaybe S.empty (u `M.lookup` groupsByUUID groupmap)
|
||||||
groupwanted s = case M.elems $ M.filterWithKey (\k _ -> S.member k s) groupwantedmap of
|
groupwanted s = case M.elems $ M.filterWithKey (\k _ -> S.member k s) groupwantedmap of
|
||||||
[pc] -> Just pc
|
[pc] -> Just pc
|
||||||
_ -> Nothing
|
_ -> Nothing
|
||||||
|
|
||||||
|
{- When a preferred content expression cannot be parsed, but is already
|
||||||
|
- in the log (eg, put there by a newer version of git-annex),
|
||||||
|
- the fallback behavior is to match only files that are currently present.
|
||||||
|
-
|
||||||
|
- This avoid unwanted/expensive changes to the content, until the problem
|
||||||
|
- is resolved. -}
|
||||||
|
unknownMatcher :: UUID -> FileMatcher
|
||||||
|
unknownMatcher u = Utility.Matcher.generate [present]
|
||||||
|
where
|
||||||
|
present = Utility.Matcher.Operation $ matchPresent (Just u)
|
||||||
|
|
||||||
{- Checks if an expression can be parsed, if not returns Just error -}
|
{- Checks if an expression can be parsed, if not returns Just error -}
|
||||||
checkPreferredContentExpression :: PreferredContentExpression -> Maybe String
|
checkPreferredContentExpression :: PreferredContentExpression -> Maybe String
|
||||||
checkPreferredContentExpression expr = case parsedToMatcher tokens of
|
checkPreferredContentExpression expr = case parsedToMatcher tokens of
|
||||||
|
|
2
debian/changelog
vendored
2
debian/changelog
vendored
|
@ -32,6 +32,8 @@ git-annex (5.20140307) UNRELEASED; urgency=medium
|
||||||
field. Also the "lastchanged" field for the date of the last change
|
field. Also the "lastchanged" field for the date of the last change
|
||||||
to any of a file's metadata.
|
to any of a file's metadata.
|
||||||
* Windows: Fix some filename encoding bugs.
|
* Windows: Fix some filename encoding bugs.
|
||||||
|
* Improve behavior when unable to parse a preferred content expression
|
||||||
|
(thanks, ion).
|
||||||
|
|
||||||
-- Joey Hess <joeyh@debian.org> Thu, 06 Mar 2014 16:17:01 -0400
|
-- Joey Hess <joeyh@debian.org> Thu, 06 Mar 2014 16:17:01 -0400
|
||||||
|
|
||||||
|
|
|
@ -149,9 +149,13 @@ group and make its preferred content be "groupwanted" will use it.
|
||||||
It's important that all clones of a repository can understand one-another's
|
It's important that all clones of a repository can understand one-another's
|
||||||
preferred content expressions, especially when using the git-annex
|
preferred content expressions, especially when using the git-annex
|
||||||
assistant. So using newly added keywords can cause a problem if
|
assistant. So using newly added keywords can cause a problem if
|
||||||
an older version of git-annex is in use elsewhere. When an old version
|
an older version of git-annex is in use elsewhere.
|
||||||
of git-annex sees a keyword it does not understand, it assumes that keyword
|
|
||||||
will match *all* files.
|
Before git-annex version 5.20140320, when git-annex saw a keyword it
|
||||||
|
did not understand, it defaulted to assuming *all* files were
|
||||||
|
preferred content. From version 5.20140320, git-annex has a nicer fallback
|
||||||
|
behavior: When it is unable to parse a preferred content expression,
|
||||||
|
it assumes all files that are currently present are preferred content.
|
||||||
|
|
||||||
Here are recent changes to preferred content expressions, and the version
|
Here are recent changes to preferred content expressions, and the version
|
||||||
they were added in.
|
they were added in.
|
||||||
|
|
Loading…
Reference in a new issue