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

fix bug in dirContains

Browse source 
dirContains "." ".." was incorrectly true
because normalize ("." </> "..") = ".."

Sponsored-by: Jochen Bartl on Patreon
This commit is contained in:
Joey Hess 2021-10-01 13:42:15 -04:00
parent e8959617b6
commit b2efbd1cd3
No known key found for this signature in database
GPG key ID: DB12DB0FF05F8F38
1 changed files with 6 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
Utility/Path.hs
View file

@ -96,7 +96,7 @@ dirContains :: RawFilePath -> RawFilePath -> Bool
dirContains a b = a == b dirContains a b = a == b
|| a' == b' || a' == b'
|| (a'' `B.isPrefixOf` b' && avoiddotdotb) || (a'' `B.isPrefixOf` b' && avoiddotdotb)
|| a' == "." && normalise ("." </> b') == b' || a' == "." && normalise ("." </> b') == b' && nodotdot b'
where where
a' = norm a a' = norm a
a'' = addTrailingPathSeparator a' a'' = addTrailingPathSeparator a'
@ -113,8 +113,11 @@ dirContains a b = a == b
- a'' is a prefix of b', so all that needs to be done is drop - a'' is a prefix of b', so all that needs to be done is drop
- that prefix, and check if the next path component is ".." - that prefix, and check if the next path component is ".."
-} -}
avoiddotdotb = not $ any (== "..") $ avoiddotdotb = nodotdot $ B.drop (B.length a'') b'
splitPath $ B.drop (B.length a'') b'
nodotdot p = all
(\s -> dropTrailingPathSeparator s /= "..")
(splitPath p)
{- Given an original list of paths, and an expanded list derived from it, {- Given an original list of paths, and an expanded list derived from it,
- which may be arbitrarily reordered, generates a list of lists, where - which may be arbitrarily reordered, generates a list of lists, where