Fix using lookupkey inside a subdirectory

Caused by dirContains ".." "foo" being incorrectly False.

Also added a test of dirContains, which includes all the previous bug fixes
I could find and some obvious cases.

Reversion in version 8.20211011

Sponsored-by: Brett Eisenberg on Patreon

Utility/Path.hs

@@ -97,6 +97,7 @@ dirContains a b = a == b
 	|| a' == b'
 	|| (a'' `B.isPrefixOf` b' && avoiddotdotb)
 	|| a' == "." && normalise ("." </> b') == b' && nodotdot b'
+	|| dotdotcontains
   where
 	a' = norm a
 	a'' = addTrailingPathSeparator a'
@@ -115,9 +116,27 @@ dirContains a b = a == b
 	 -}
 	avoiddotdotb = nodotdot $ B.drop (B.length a'') b'
 
-	nodotdot p = all
-		(\s -> dropTrailingPathSeparator s /= "..")
-		(splitPath p)
+	nodotdot p = all (not . isdotdot) (splitPath p)
+	
+	isdotdot s = dropTrailingPathSeparator s == ".."
+
+	{- This handles the case where a is ".." or "../.." etc,
+	 - and b is "foo" or "../foo" etc. The rule is that when
+	 - a is entirely ".." components, b is under it when it starts
+	 - with fewer ".." components. 
+	 - 
+	 - Due to the use of norm, cases like "../../foo/../../" get
+	 - converted to eg "../../../" and so do not need to be handled
+	 - specially here.
+	 -}
+	dotdotcontains
+		| isAbsolute b' = False
+		| otherwise = 
+			let aps = splitPath a'
+			    bps = splitPath b'
+			in if all isdotdot aps
+				then length (takeWhile isdotdot bps) < length aps
+				else False
 
 {- Given an original list of paths, and an expanded list derived from it,
  - which may be arbitrarily reordered, generates a list of lists, where

Utility/Path/Tests.hs

@@ -14,6 +14,7 @@ module Utility.Path.Tests (
 	prop_upFrom_basics,
 	prop_relPathDirToFileAbs_basics,
 	prop_relPathDirToFileAbs_regressionTest,
+	prop_dirContains_regressionTest,
 ) where
 
 import System.FilePath.ByteString
@@ -62,3 +63,18 @@ prop_relPathDirToFileAbs_regressionTest = same_dir_shortcurcuits_at_difference
 		relPathDirToFileAbs (joinPath [pathSeparator `B.cons` "tmp", "r", "lll", "xxx", "yyy", "18"])
 			(joinPath [pathSeparator `B.cons` "tmp", "r", ".git", "annex", "objects", "18", "gk", "SHA256-foo", "SHA256-foo"])
 				== joinPath ["..", "..", "..", "..", ".git", "annex", "objects", "18", "gk", "SHA256-foo", "SHA256-foo"]
+
+prop_dirContains_regressionTest :: Bool
+prop_dirContains_regressionTest = and
+	[ not $ dirContains "." ".."
+	, not $ dirContains ".." "../.."
+	, dirContains "." "foo"
+	, dirContains "." "."
+	, dirContains ".." ".."
+	, dirContains "../.." "../.."
+	, dirContains "." "./foo"
+	, dirContains ".." "../foo"
+	, dirContains "../.." "../foo"
+	, dirContains "../.." "../../foo"
+	, not $ dirContains "../.." "../../.."
+	]