From cdaeb32139b83c7fb93c1891854ad81d1c1ce96d Mon Sep 17 00:00:00 2001
From: jonny <ga86lad@mytum.de>
Date: Fri, 31 Dec 2021 20:35:55 +0100
Subject: [PATCH] check scriptUrl for script path
---
lib/Properties.hs | 15 ++++++++++-----
1 file changed, 10 insertions(+), 5 deletions(-)
diff --git a/lib/Properties.hs b/lib/Properties.hs
index 00d03da..73c6467 100644
--- a/lib/Properties.hs
+++ b/lib/Properties.hs
@@ -12,7 +12,7 @@ module Properties (checkMap, checkTileset, checkLayer) where
import Control.Monad (forM, forM_, unless, when)
-import Data.Text (Text, intercalate, isPrefixOf, isInfixOf)
+import Data.Text (Text, intercalate, isPrefixOf, isInfixOf, unpack)
import qualified Data.Text as T
import qualified Data.Vector as V
import Tiled (Layer (..), Object (..), Property (..),
@@ -45,6 +45,7 @@ import Paths (PathResult (..), RelPath (..), getExtension,
isOldStyle, parsePath)
import Types (Dep (Link, Local, LocalMap, MapLink))
import Uris (SubstError (..), applySubsts, parseUri, extractDomain)
+import Debug.Trace (traceId, traceShow, trace)
@@ -142,7 +143,7 @@ checkMapProperty p@(Property name _) = case name of
-- scripts can be used by one map
_ | T.toLower name == "script" ->
unwrapString p $ \str ->
- unless ((checkIsRc3Url str) &&
+ unless ((checkIsRc3ScriptUrl str) &&
(not $ "/../" `isInfixOf` str) &&
(not $ "%" `isInfixOf` str) &&
(not $ "@" `isInfixOf` str))
@@ -339,11 +340,15 @@ checkObjectGroupProperty (Property name _) = case name of
_ -> warn $ "unknown property " <> prettyprint name <> " for objectgroup layers"
checkIsRc3Url :: Text -> Bool
-checkIsRc3Url text= case extractDomain text of
+checkIsRc3Url text=
+ case parseUri text of
Nothing -> False
- Just domain -> do
- domain == "https://static.rc3.world"
+ Just (protocol,domain,_) -> protocol=="https" && domain == "static.rc3.world"
+checkIsRc3ScriptUrl :: Text -> Bool
+checkIsRc3ScriptUrl url = checkIsRc3Url url && case parseUri url of
+ Nothing -> False
+ Just (_,_,path) -> "/scripts" `isPrefixOf` path
-- | Checks a single (custom) property of a "normal" tile layer
checkTileLayerProperty :: Property -> LintWriter Layer
--
GitLab