[#197] Recover indirections through parent check

Author: aeqz

src/Xrefcheck/System.hs

@@ -13,6 +13,7 @@ module Xrefcheck.System
   , getDirsBetweenRootAndFile
   , getPosixRelativeChild
   , getPosixRelativeOrAbsoluteChild
+  , hasIndirectionThroughParent
   , takeDirectory
   , takeExtension
   , (</)
@@ -129,6 +130,18 @@ getPosixRelativeOrAbsoluteChild :: CanonicalPath -> CanonicalPath -> FilePath
 getPosixRelativeOrAbsoluteChild root child =
   fromMaybe (unCanonicalPath child) (getPosixRelativeChild root child)
 
+-- | Check if some 'FilePath' passes through its parent while
+-- expanding indirections.
+hasIndirectionThroughParent :: FilePath -> Bool
+hasIndirectionThroughParent = go 0 . FP.splitDirectories
+  where
+    go :: Int -> [FilePath] -> Bool
+    go _ [] = False
+    go 0 (".." : _) = True
+    go acc (".." : xs) = go (acc - 1) xs
+    go acc ("." : xs) = go acc xs
+    go acc (_ : xs) = go (acc + 1) xs
+
 -- | Extend some 'CanonicalPath' with a given relative 'FilePath'.
 --
 -- The right-hand side 'FilePath' can use both Posix and Windows

src/Xrefcheck/Verify.hs

@@ -533,12 +533,18 @@ verifyReference
 
     isVirtual canonicalRoot = matchesGlobPatterns canonicalRoot (ecIgnoreLocalRefsTo cExclusions)
 
-    -- Checks a local file reference. The `shownFilepath` argument is intended
-    -- to be shown in the error report when the `referredFile` path is not
-    -- a child of `canonicalRoot`, so it allows indirections and should be
-    -- suitable for being shown to the user.
+    -- Checks a local file reference.
+    --
+    -- The `shownFilepath` argument is intended to be shown in the error
+    -- report when the `referredFile` path is not a child of `canonicalRoot`,
+    -- so it allows indirections and should be suitable for being shown to
+    -- the user. Also, it will be considered as outside the repository if
+    -- it is relative and its idirections pass through the repository root.
     checkRef mAnchor canonicalRoot referredFile shownFilepath = verifying $
       unless (isVirtual canonicalRoot referredFile) do
+        when (hasIndirectionThroughParent shownFilepath) $
+          throwError $ LocalFileOutsideRepo shownFilepath
+
         referredFileRelative <-
           case getPosixRelativeChild canonicalRoot referredFile of
             Just ps -> pure ps

tests/golden/check-local-refs/expected2.gold

@@ -97,6 +97,24 @@
      File does not exist:
        dir1/dir2/d2f2.md
 
+  ➥  In file dir2/d2f1.md
+     bad reference (relative) at src:51:1-42:
+       - text: "path-through-top-dir"
+       - link: ../../dir1/d1f1.md
+       - anchor: -
+
+     Link targets a local file outside repository:
+       dir2/../../dir1/d1f1.md
+
+  ➥  In file dir2/d2f1.md
+     bad reference (relative) at src:52:1-75:
+       - text: "path-through-top-dir-with-anchor"
+       - link: ../../dir1/d1f1.md
+       - anchor: existing-anchor-d1f1
+
+     Link targets a local file outside repository:
+       dir2/../../dir1/d1f1.md
+
   ➥  In file dir2/d2f1.md
      bad reference (relative) at src:53:1-26:
        - text: "ref-to-d0"
@@ -124,4 +142,4 @@
      Link targets a local file outside repository:
        b/../../b.md
 
-Invalid references dumped, 14 in total.
+Invalid references dumped, 16 in total.

tests/golden/check-local-refs/expected3.gold

@@ -88,4 +88,22 @@
      File does not exist:
        dir1/dir2/d2f2.md
 
-Invalid references dumped, 10 in total.
+  ➥  In file dir2/d2f1.md
+     bad reference (relative) at src:51:1-42:
+       - text: "path-through-top-dir"
+       - link: ../../dir1/d1f1.md
+       - anchor: -
+
+     Link targets a local file outside repository:
+       dir2/../../dir1/d1f1.md
+
+  ➥  In file dir2/d2f1.md
+     bad reference (relative) at src:52:1-75:
+       - text: "path-through-top-dir-with-anchor"
+       - link: ../../dir1/d1f1.md
+       - anchor: existing-anchor-d1f1
+
+     Link targets a local file outside repository:
+       dir2/../../dir1/d1f1.md
+
+Invalid references dumped, 12 in total.