diff options
author | stuebinm | 2021-12-02 02:27:30 +0100 |
---|---|---|
committer | stuebinm | 2021-12-02 02:27:30 +0100 |
commit | c2a49d6ea46c38f107ac1a47a965e4777be2aecc (patch) | |
tree | 940080d78358a7e8c6bb62435949d1750b8955ca | |
parent | 7033597e239d37fd14890c96ae5f07b94a15953d (diff) |
do (naïve) html escaping
because we can't ever trust workadventure, apparently.
why are we using that thing again?
Diffstat (limited to '')
-rw-r--r-- | lib/Properties.hs | 17 | ||||
-rw-r--r-- | lib/Util.hs | 6 |
2 files changed, 17 insertions, 6 deletions
diff --git a/lib/Properties.hs b/lib/Properties.hs index 7772c26..f78ceff 100644 --- a/lib/Properties.hs +++ b/lib/Properties.hs @@ -68,7 +68,7 @@ checkMap = do -- Doesn't really do all that much, but could in theory be expanded into a -- longer function same as checkLayerProperty. checkMapProperty :: Property -> LintWriter Tiledmap -checkMapProperty (Property name _value) = case name of +checkMapProperty p@(Property name _value) = case name of "script" -> do -- this is kind of stupid, since if we also inject script this -- will be overriden anyways, but it also doesn't really hurt I guess @@ -80,11 +80,11 @@ checkMapProperty (Property name _value) = case name of lintConfig configScriptInject >>= \case Nothing -> pure () Just url -> setProperty "script" url - "mapName" -> pure () + "mapName" -> naiveEscapeProperty p "mapLink" -> pure () "mapImage" -> pure () - "mapDescription" -> pure () - "mapCopyright" -> pure () + "mapDescription" -> naiveEscapeProperty p + "mapCopyright" -> naiveEscapeProperty p _ -> complain $ "unknown map property " <> prettyprint name where @@ -118,8 +118,8 @@ checkTileset = do mapM_ checkTilesetProperty (fromMaybe [] $ tilesetProperties tileset) checkTilesetProperty :: Property -> LintWriter Tileset -checkTilesetProperty (Property name _value) = case name of - "copyright" -> pure () -- only allow some licenses? +checkTilesetProperty p@(Property name _value) = case name of + "copyright" -> naiveEscapeProperty p _ -> pure () -- are there any other properties? @@ -182,6 +182,7 @@ checkLayerProperty p@(Property name _value) = case name of (\link -> do dependsOn (Link link) setProperty "openWebsite" link + setProperty "silent" (BoolProp True) setProperty "openWebsitePolicy" ("fullscreen;camera;microphone;display-capture" :: Text) ) @@ -400,3 +401,7 @@ unwrapURI sym p@(Property name _) f g = unwrapLink p $ \link -> do "the URI schema " <> schema <> ":// does not exist." WrongScope schema -> "the URI schema " <> schema <> ":// cannot be used on \""<>name<>"\"." + +naiveEscapeProperty :: HasProperties a => Property -> LintWriter a +naiveEscapeProperty prop@(Property name _) = + unwrapString prop (setProperty name . naiveEscapeHTML) diff --git a/lib/Util.hs b/lib/Util.hs index 18dfb5b..948b725 100644 --- a/lib/Util.hs +++ b/lib/Util.hs @@ -35,6 +35,7 @@ instance PrettyPrint PropertyValue where prettyprint = \case StrProp str -> str BoolProp bool -> if bool then "true" else "false" + IntProp int -> showText int -- | here since Unit is sometimes used as dummy type instance PrettyPrint () where @@ -54,3 +55,8 @@ layerIsEmpty :: Layer -> Bool layerIsEmpty layer = case layerData layer of Nothing -> True Just d -> all ((==) $ mkTiledId 0) d + +-- | naive escaping of html sequences, just to be sure that +-- | workadventure won't mess things up again … +naiveEscapeHTML :: Text -> Text +naiveEscapeHTML = T.replace "<" "<" . T.replace ">" ">" |