mirrors/git-annex
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages 1 Wiki Activity Actions

reject views with too many nested subdirs

Browse source
This commit is contained in:
Joey Hess 2014-02-19 01:28:48 -04:00
parent 4e0be2792b
commit 0b7ede2088
1 changed files with 18 additions and 12 deletions
Download patch file Download diff file Expand all files Collapse all files

30
Annex/View.hs
View file

@ -35,6 +35,20 @@ data ViewChange = Unchanged | Narrowing | Widening
matchGlob :: String -> String -> Bool matchGlob :: String -> String -> Bool
matchGlob glob val = wildCheckCase glob val matchGlob glob val = wildCheckCase glob val
{- Each multivalued ViewFilter in a view results in another level of
- subdirectory nesting. When a file matches multiple ways, it will appear
- in multiple subdirectories. This means there is a bit of an exponential
- blowup with a single file appearing in a crazy number of places!
-
- Capping the view size to 5 is reasonable; why wants to dig
- through 5+ levels of subdirectories to find anything?
-}
viewTooLarge :: View -> Bool
viewTooLarge view = visibleViewSize view > 5
visibleViewSize :: View -> Int
visibleViewSize = length . filter (multiValue . viewFilter) . viewComponents
{- Updates a view, adding a new field to filter on (Narrowing), {- Updates a view, adding a new field to filter on (Narrowing),
- or allowing a new value in an existing field (Widening). -} - or allowing a new value in an existing field (Widening). -}
refineView :: View -> MetaField -> String -> (View, ViewChange) refineView :: View -> MetaField -> String -> (View, ViewChange)
@ -42,7 +56,10 @@ refineView view field wanted
| field `elem` (map viewField components) = | field `elem` (map viewField components) =
let (components', viewchanges) = runWriter $ mapM updatefield components let (components', viewchanges) = runWriter $ mapM updatefield components
in (view { viewComponents = components' }, maximum viewchanges) in (view { viewComponents = components' }, maximum viewchanges)
| otherwise = (view { viewComponents = ViewComponent field viewfilter : components }, Narrowing) | otherwise = let view' = view { viewComponents = ViewComponent field viewfilter : components }
in if viewTooLarge view'
then error $ "View is too large (" ++ show (visibleViewSize view') ++ " levels of subdirectories)"
else (view', Narrowing)
where where
components = viewComponents view components = viewComponents view
viewfilter viewfilter
@ -86,17 +103,6 @@ combineViewFilter (FilterGlob old) newglob@(FilterGlob new)
| matchGlob old new = (newglob, Narrowing) | matchGlob old new = (newglob, Narrowing)
| otherwise = (newglob, Widening) | otherwise = (newglob, Widening)
{- Each multivalued ViewFilter in a view results in another level of
- subdirectory nesting. When a file matches multiple ways, it will appear
- in multiple subdirectories. This means there is a bit of an exponential
- blowup with a single file appearing in a crazy number of places!
-
- Capping the view size to 5 is reasonable; why wants to dig
- through 5+ levels of subdirectories to find anything?
-}
viewTooLarge :: View -> Bool
viewTooLarge view = length (filter (multiValue . viewFilter) (viewComponents view)) > 5
{- Checks if metadata matches a filter, and if so returns the value, {- Checks if metadata matches a filter, and if so returns the value,
- or values that match. -} - or values that match. -}
matchFilter :: MetaData -> ViewComponent -> Maybe [MetaValue] matchFilter :: MetaData -> ViewComponent -> Maybe [MetaValue]