From 5060f68b9728bf94818ee985c16c25511f248143 Mon Sep 17 00:00:00 2001
From: stuebinm
Date: Mon, 20 Dec 2021 00:15:08 +0100
Subject: disallow extended API variables in links

---
 lib/Paths.hs      | 10 ++++++++--
 lib/Properties.hs |  2 ++
 lib/Uris.hs       |  6 +++++-
 3 files changed, 15 insertions(+), 3 deletions(-)

diff --git a/lib/Paths.hs b/lib/Paths.hs
index f72874f..d2861eb 100644
--- a/lib/Paths.hs
+++ b/lib/Paths.hs
@@ -20,12 +20,18 @@ data RelPath = Path Int Text (Maybe Text)
 
 
 
-data PathResult = OkRelPath RelPath | AbsolutePath | NotAPath | UnderscoreMapLink | AtMapLink
+data PathResult = OkRelPath RelPath
+  | AbsolutePath
+  | NotAPath
+  | UnderscoreMapLink
+  | AtMapLink
+  | PathVarsDisallowed
 
 -- | horrible regex parsing for filepaths that is hopefully kinda safe
 parsePath :: Text -> PathResult
 parsePath text =
-  if | rest =~ ("^([^/]*[^\\./]/)*[^/]*[^\\./]$" :: Text) -> OkRelPath (Path up path fragment)
+  if | text =~ ("{{{.*}}}" :: Text) -> PathVarsDisallowed
+     | rest =~ ("^([^/]*[^\\./]/)*[^/]*[^\\./]$" :: Text) -> OkRelPath (Path up path fragment)
      | "/_/" `isPrefixOf` text ->  UnderscoreMapLink
      | "/@/" `isPrefixOf` text ->  AtMapLink
      | "/" `isPrefixOf` text ->  AbsolutePath
diff --git a/lib/Properties.hs b/lib/Properties.hs
index a326e30..797a1d7 100644
--- a/lib/Properties.hs
+++ b/lib/Properties.hs
@@ -556,6 +556,7 @@ unwrapPath str f = case parsePath str of
   AbsolutePath -> forbid "absolute paths are disallowed. Use world:// instead."
   UnderscoreMapLink -> forbid "map links using /_/ are disallowed. Use world:// instead."
   AtMapLink -> forbid "map links using /@/ are disallowed. Use world:// instead."
+  PathVarsDisallowed -> forbid "extended API variables are not allowed in asset paths."
 
 unwrapBadgeToken :: Text -> (BadgeToken -> LintWriter a) -> LintWriter a
 unwrapBadgeToken str f = case parseToken str of
@@ -583,6 +584,7 @@ unwrapURI sym p@(Property name _) f g = unwrapString p $ \link -> do
         \\"" <> name <> "\"; allowed "
         <> (if length allowed == 1 then "is " else "are ")
         <> intercalate ", " (fmap (<> "://") allowed) <> "."
+      VarsDisallowed -> "extended API links are disallowed in links"
 
 -- | just asserts that this is a string
 isString :: Property -> LintWriter a
diff --git a/lib/Uris.hs b/lib/Uris.hs
index 5ad9180..e2d9a5f 100644
--- a/lib/Uris.hs
+++ b/lib/Uris.hs
@@ -9,7 +9,7 @@ module Uris where
 
 
 
-import           Control.Monad           (unless)
+import           Control.Monad           (unless, when)
 import           Data.Aeson              (FromJSON (..), Options (..),
                                           SumEncoding (UntaggedValue),
                                           defaultOptions, genericParseJSON)
@@ -58,6 +58,7 @@ data SubstError =
   | IsBlocked
   | DomainDoesNotExist Text
   | WrongScope Text [Text]
+  | VarsDisallowed
   -- ^ This link's schema exists, but cannot be used in this scope.
   -- The second field contains a list of schemas that may be used instead.
 
@@ -65,7 +66,10 @@ data SubstError =
 applySubst :: KnownSymbol s
   => Proxy s -> SchemaSet -> Text -> Either SubstError Text
 applySubst s substs uri =  do
+  when (uri =~ "{{{.*}}}")
+   $ Left VarsDisallowed
   (schema, domain, rest) <- note NotALink $ parseUri uri
+
   rules <- note (SchemaDoesNotExist schema) ( M.lookup schema substs)
   unless (symbolVal s `elem` scope rules)
         $ Left (WrongScope schema
-- 
cgit v1.2.3