From 5060f68b9728bf94818ee985c16c25511f248143 Mon Sep 17 00:00:00 2001
From: stuebinm <stuebinm@disroot.org>
Date: Mon, 20 Dec 2021 00:15:08 +0100
Subject: [PATCH] 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
--
GitLab