[#138] Report links that escape repo directory

Problem: as in #138, when we see a local link, we are checking only
existance of referred file,
not checking that this file is a part of repo
and link will compatible with Github's renderer

Solution: manually count "nesting levels" of all local links,
checking that number of `".."`'s is always less
then number of real directories

Solution

src/Xrefcheck/Verify.hs

@@ -57,7 +57,7 @@ import Network.HTTP.Types.Header (hRetryAfter)
 import Network.HTTP.Types.Status (Status, statusCode, statusMessage)
 import System.Console.Pretty (Style (..), style)
 import System.Directory (doesDirectoryExist, doesFileExist)
-import System.FilePath (takeDirectory, (</>), normalise)
+import System.FilePath (takeDirectory, (</>), normalise, splitDirectories, makeRelative)
 import Text.ParserCombinators.ReadPrec qualified as ReadPrec (lift)
 import Text.Regex.TDFA.Text (Regex, regexec)
 import Text.URI (Authority (..), URI (..), mkURIBs, ParseExceptionBs)
@@ -119,6 +119,7 @@ instance Buildable a => Buildable (WithReferenceLoc a) where
 
 data VerifyError
   = LocalFileDoesNotExist FilePath
+  | LocalFileOutsideRepo FilePath
   | AnchorDoesNotExist Text [Anchor]
   | AmbiguousAnchorRef FilePath Text (NonEmpty Anchor)
   | ExternalResourceInvalidUri URIBS.URIParseError
@@ -138,6 +139,9 @@ instance Buildable VerifyError where
     LocalFileDoesNotExist file ->
       "⛀  File does not exist:\n   " +| file |+ "\n"
 
+    LocalFileOutsideRepo file ->
+      "⛀  Link targets a local file outside repository:\n   " +| file |+ "\n"
+
     AnchorDoesNotExist anchor similar ->
       "⛀  Anchor '" +| anchor |+ "' is not present" +|
       anchorHints similar
@@ -404,12 +408,29 @@ verifyReference
       _ -> Nothing
 
     checkRef mAnchor referredFile = verifying $ do
+      checkReferredFileIsInsideRepo referredFile
       checkReferredFileExists referredFile
       case M.lookup referredFile repoInfo of
         Nothing -> pass  -- no support for such file, can do nothing
         Just referredFileInfo -> whenJust mAnchor $
           checkAnchor referredFile (_fiAnchors referredFileInfo)
 
+    checkReferredFileIsInsideRepo file = unless
+      (noNegativeNesting $ makeRelative root file)
+      $ throwError (LocalFileOutsideRepo file)
+      where
+        -- | checks that relative filepath fully belongs to current directory
+        -- noNegativeNesting "a/../b" = True
+        -- noNegativeNesting "a/../../b" = False
+        noNegativeNesting path = all (>= 0) $ scanl
+          (\n dir -> n + nestingChange dir)
+          (0 :: Integer)
+          $ splitDirectories path
+
+        nestingChange ".." = -1
+        nestingChange "." = 0
+        nestingChange _ = 1
+
     checkReferredFileExists file = do
       let fileExists = readingSystem $ doesFileExist file
       let dirExists = readingSystem $ doesDirectoryExist file