diff options
Diffstat (limited to 'lib/Properties.hs')
| -rw-r--r-- | lib/Properties.hs | 68 |
1 files changed, 28 insertions, 40 deletions
diff --git a/lib/Properties.hs b/lib/Properties.hs index 63cea1f..b937534 100644 --- a/lib/Properties.hs +++ b/lib/Properties.hs @@ -15,7 +15,7 @@ module Properties (checkMap, checkTileset, checkLayer) where import Universum hiding (intercalate, isPrefixOf) -import Data.Text (intercalate, isInfixOf, isPrefixOf) +import Data.Text (intercalate, isPrefixOf) import qualified Data.Text as T import Data.Tiled (Layer (..), Object (..), Property (..), PropertyValue (..), Tile (..), @@ -42,8 +42,7 @@ import LintWriter (LintWriter, adjust, askContext, import Paths (PathResult (..), RelPath (..), getExtension, isOldStyle, parsePath) import Types (Dep (Link, Local, LocalMap, MapLink)) -import Uris (SubstError (..), applySubsts, - extractDomain, parseUri) +import Uris (SubstError (..), applySubsts) @@ -140,12 +139,9 @@ checkMapProperty p@(Property name _) = case name of -- "canonical" form, but allowing that here so that multiple -- scripts can be used by one map _ | T.toLower name == "script" -> - unwrapString p $ \str -> - unless (checkIsRc3Url str && - not ( "/../" `isInfixOf` str) && - not ( "%" `isInfixOf` str) && - not ( "@" `isInfixOf` str)) - $ forbid "only scripts hosted on static.rc3.world are allowed." + unwrapURI (Proxy @"script") p + (dependsOn . Link) + (const $ forbid "scripts loaded from local files are disallowed") | name `elem` ["jitsiRoom", "playAudio", "openWebsite" , "url", "exitUrl", "silent", "getBadge"] -> complain $ "property " <> name @@ -342,11 +338,6 @@ checkObjectGroupProperty (Property name _) = case name of \not the object layer." _ -> warn $ "unknown property " <> prettyprint name <> " for objectgroup layers" -checkIsRc3Url :: Text -> Bool -checkIsRc3Url text= case extractDomain text of - Nothing -> False - Just domain -> do - domain == "https://static.rc3.world" -- | Checks a single (custom) property of a "normal" tile layer @@ -405,7 +396,8 @@ checkTileThing removeExits p@(Property name _value) = case name of unwrapURI (Proxy @"map") p (\link -> do assemblyslug <- lintConfig configAssemblyTag - case T.stripPrefix ("/@/rc3_21/"<>assemblyslug<>"/") link of + eventslug <- lintConfig configEventSlug + case T.stripPrefix ("/@/"<>eventslug<>"/"<>assemblyslug<>"/") link of Nothing -> do dependsOn (MapLink link) setProperty "exitUrl" link @@ -424,8 +416,8 @@ checkTileThing removeExits p@(Property name _value) = case name of let ext = getExtension path in if | isOldStyle path -> complain "Old-Style inter-repository links (using {<placeholder>}) \ - \cannot be used at rC3 2021; please use world:// instead \ - \(see howto.rc3.world)." + \cannot be used at divoc bb3; please use world:// instead \ + \(see https://di.c3voc.de/howto:world)." | ext == "tmx" -> complain "Cannot use .tmx map format; use Tiled's json export instead." | ext /= "json" -> @@ -471,22 +463,21 @@ checkTileThing removeExits p@(Property name _value) = case name of , "jitsiroomadmintag", "jitsiinterfaceconfig" , "openwebsitepolicy", "allowapi" ] -> forbidProperty name - -- the openWebsite Api can only be allowed if the website is on static.rc3.world - | T.toLower name == "openwebsiteallowapi" - -> do - properties <- askContext <&> getProperties - unless (all (\(Property name value) -> case value of - StrProp str -> name /= "openWebsite" || checkIsRc3Url str - _ -> True - ) properties) - $ complain "\"openWebsiteAllowApi\" can only be used with websites hosted \ - \on https://static.rc3.world" | name `elem` [ "openWebsite", "openTab" ] -> do uselessEmptyLayer - suggestProperty $ Property "openWebsiteTrigger" (StrProp "onaction") - unwrapURI (Proxy @"website") p - (dependsOn . Link) - (const $ forbid "accessing local html files is disallowed.") + suggestProperty $ Property "openWebsiteTrigger" "onaction" + + properties <- askContext <&> getProperties + let isScript = any (\(Property name _) -> + T.toLower name == "openwebsiteallowapi") + properties + if isScript + then unwrapURI (Proxy @"script") p + (dependsOn . Link) + (const $ forbid "accessing local html files is disallowed") + else unwrapURI (Proxy @"website") p + (dependsOn . Link) + (const $ forbid "accessing local html files is disallowed.") | otherwise -> when (not removeExits || name `notElem` [ "collides", "name", "tilesetCopyright" ]) $ do warnUnknown p knownTileLayerProperites @@ -634,11 +625,6 @@ setProperty name value = adjust $ \ctxt -> $ \ps -> Just $ Property name (asProperty value) : filter sameName ps where sameName (Property name' _) = name /= name' -removeProperty :: HasProperties ctxt => Text -> LintWriter ctxt -removeProperty name = adjust $ \ctxt -> - flip adjustProperties ctxt - $ \ps -> Just $ filter (\(Property name' _) -> name' /= name) ps - naiveEscapeProperty :: HasProperties a => Property -> LintWriter a naiveEscapeProperty prop@(Property name _) = unwrapString prop (setProperty name . naiveEscapeHTML) @@ -691,7 +677,9 @@ unwrapBadgeToken str f = case parseToken str of Nothing -> complain "invalid badge token." --- | unwraps a URI +-- | unwraps a link, giving two cases: +-- - the link might be an (allowed) remote URI +-- - the link might be relative to this map (i.e. just a filepath) unwrapURI :: (KnownSymbol s, HasProperties a) => Proxy s -> Property @@ -715,12 +703,12 @@ unwrapURI sym p@(Property name _) f g = unwrapString p $ \link -> do DomainDoesNotExist domain -> "The domain " <> domain <> " does not exist; \ \please make sure it is spelled correctly." SchemaDoesNotExist schema -> - "the URI schema " <> schema <> ":// cannot be used." + "the URI schema " <> schema <> "// cannot be used." WrongScope schema allowed -> - "the URI schema " <> schema <> ":// cannot be used in property \ + "the URI schema " <> schema <> "// cannot be used in property \ \\"" <> name <> "\"; allowed " <> (if length allowed == 1 then "is " else "are ") - <> intercalate ", " (fmap (<> "://") allowed) <> "." + <> intercalate ", " (map (<> "//") allowed) <> "." VarsDisallowed -> "extended API links are disallowed in links" |