fixed url injection by means of starting an url with "." and turning the prefix into a subdomain

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