Skip to content
Snippets Groups Projects
Commit c2a49d6e authored by stuebinm's avatar stuebinm
Browse files

do (naïve) html escaping

because we can't ever trust workadventure, apparently.

why are we using that thing again?
parent 7033597e
No related branches found
No related tags found
No related merge requests found
...@@ -68,7 +68,7 @@ checkMap = do ...@@ -68,7 +68,7 @@ checkMap = do
-- Doesn't really do all that much, but could in theory be expanded into a -- Doesn't really do all that much, but could in theory be expanded into a
-- longer function same as checkLayerProperty. -- longer function same as checkLayerProperty.
checkMapProperty :: Property -> LintWriter Tiledmap checkMapProperty :: Property -> LintWriter Tiledmap
checkMapProperty (Property name _value) = case name of checkMapProperty p@(Property name _value) = case name of
"script" -> do "script" -> do
-- this is kind of stupid, since if we also inject script this -- 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 -- will be overriden anyways, but it also doesn't really hurt I guess
...@@ -80,11 +80,11 @@ checkMapProperty (Property name _value) = case name of ...@@ -80,11 +80,11 @@ checkMapProperty (Property name _value) = case name of
lintConfig configScriptInject >>= \case lintConfig configScriptInject >>= \case
Nothing -> pure () Nothing -> pure ()
Just url -> setProperty "script" url Just url -> setProperty "script" url
"mapName" -> pure () "mapName" -> naiveEscapeProperty p
"mapLink" -> pure () "mapLink" -> pure ()
"mapImage" -> pure () "mapImage" -> pure ()
"mapDescription" -> pure () "mapDescription" -> naiveEscapeProperty p
"mapCopyright" -> pure () "mapCopyright" -> naiveEscapeProperty p
_ -> complain $ "unknown map property " <> prettyprint name _ -> complain $ "unknown map property " <> prettyprint name
where where
...@@ -118,8 +118,8 @@ checkTileset = do ...@@ -118,8 +118,8 @@ checkTileset = do
mapM_ checkTilesetProperty (fromMaybe [] $ tilesetProperties tileset) mapM_ checkTilesetProperty (fromMaybe [] $ tilesetProperties tileset)
checkTilesetProperty :: Property -> LintWriter Tileset checkTilesetProperty :: Property -> LintWriter Tileset
checkTilesetProperty (Property name _value) = case name of checkTilesetProperty p@(Property name _value) = case name of
"copyright" -> pure () -- only allow some licenses? "copyright" -> naiveEscapeProperty p
_ -> pure () -- are there any other properties? _ -> pure () -- are there any other properties?
...@@ -182,6 +182,7 @@ checkLayerProperty p@(Property name _value) = case name of ...@@ -182,6 +182,7 @@ checkLayerProperty p@(Property name _value) = case name of
(\link -> do (\link -> do
dependsOn (Link link) dependsOn (Link link)
setProperty "openWebsite" link setProperty "openWebsite" link
setProperty "silent" (BoolProp True)
setProperty "openWebsitePolicy" setProperty "openWebsitePolicy"
("fullscreen;camera;microphone;display-capture" :: Text) ("fullscreen;camera;microphone;display-capture" :: Text)
) )
...@@ -400,3 +401,7 @@ unwrapURI sym p@(Property name _) f g = unwrapLink p $ \link -> do ...@@ -400,3 +401,7 @@ unwrapURI sym p@(Property name _) f g = unwrapLink p $ \link -> do
"the URI schema " <> schema <> ":// does not exist." "the URI schema " <> schema <> ":// does not exist."
WrongScope schema -> WrongScope schema ->
"the URI schema " <> schema <> ":// cannot be used on \""<>name<>"\"." "the URI schema " <> schema <> ":// cannot be used on \""<>name<>"\"."
naiveEscapeProperty :: HasProperties a => Property -> LintWriter a
naiveEscapeProperty prop@(Property name _) =
unwrapString prop (setProperty name . naiveEscapeHTML)
...@@ -35,6 +35,7 @@ instance PrettyPrint PropertyValue where ...@@ -35,6 +35,7 @@ instance PrettyPrint PropertyValue where
prettyprint = \case prettyprint = \case
StrProp str -> str StrProp str -> str
BoolProp bool -> if bool then "true" else "false" BoolProp bool -> if bool then "true" else "false"
IntProp int -> showText int
-- | here since Unit is sometimes used as dummy type -- | here since Unit is sometimes used as dummy type
instance PrettyPrint () where instance PrettyPrint () where
...@@ -54,3 +55,8 @@ layerIsEmpty :: Layer -> Bool ...@@ -54,3 +55,8 @@ layerIsEmpty :: Layer -> Bool
layerIsEmpty layer = case layerData layer of layerIsEmpty layer = case layerData layer of
Nothing -> True Nothing -> True
Just d -> all ((==) $ mkTiledId 0) d 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 "<" "&lt;" . T.replace ">" "&gt;"
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment