diff --git a/lib/Properties.hs b/lib/Properties.hs index 00d03da488100ee128907347d0fc95002f86b861..73c6467a41ea78eb6a4fb2a5d252c3c0a693f0b8 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