diff options
| -rw-r--r-- | lib/Properties.hs | 12 | ||||
| -rw-r--r-- | lib/Uris.hs | 30 | ||||
| -rw-r--r-- | walint.cabal | 3 |
3 files changed, 32 insertions, 13 deletions
diff --git a/lib/Properties.hs b/lib/Properties.hs index 31823e6..f346f7f 100644 --- a/lib/Properties.hs +++ b/lib/Properties.hs @@ -45,7 +45,7 @@ import LintWriter (LintWriter, adjust, askContext, import Paths (PathResult (..), RelPath (..), getExtension, isOldStyle, parsePath) import Types (Dep (Link, Local, LocalMap, MapLink)) -import Uris (SubstError (..), applySubsts, parseUri) +import Uris (SubstError (..), applySubsts, parseUri, extractDomain) @@ -143,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 (("https://static.rc3.world/scripts" `isPrefixOf` str) && + unless ((checkIsRc3Url str) && (not $ "/../" `isInfixOf` str) && (not $ "%" `isInfixOf` str) && (not $ "@" `isInfixOf` str)) @@ -344,6 +344,12 @@ 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 checkTileThing :: (HasProperties a, HasName a, HasData a) => Bool -> Property -> LintWriter a @@ -500,7 +506,7 @@ checkTileThing removeExits p@(Property name _value) = case name of -> do properties <- askContext <&> getProperties unless (all (\(Property name value) -> case value of - StrProp str -> name /= "openWebsite" || "https://static.rc3.world/" `isPrefixOf` str + StrProp str -> name /= "openWebsite" || checkIsRc3Url str _ -> True ) properties) $ complain "\"openWebsiteAllowApi\" can only be used with websites hosted \ diff --git a/lib/Uris.hs b/lib/Uris.hs index 6436ac6..80ee014 100644 --- a/lib/Uris.hs +++ b/lib/Uris.hs @@ -18,7 +18,7 @@ import Data.Data (Proxy) import Data.Either.Combinators (maybeToRight, rightToMaybe) import Data.Map.Strict (Map) import qualified Data.Map.Strict as M -import Data.Text (Text, pack) +import Data.Text (Text, pack, unpack) import qualified Data.Text as T import GHC.Generics (Generic) import GHC.TypeLits (KnownSymbol, symbolVal) @@ -26,6 +26,9 @@ import Network.URI.Encode as URI import Text.Regex.TDFA ((=~)) import Witherable (mapMaybe) +import Network.URI as NativeUri +import Data.String + data Substitution = Prefixed { prefix :: Text, blocked :: [Text], allowed :: [Text], scope :: [String] } | DomainSubstitution { substs :: Map Text Text, scope :: [String] } @@ -44,17 +47,26 @@ type SchemaSet = [(Text, Substitution)] extractDomain :: Text -> Maybe Text extractDomain url = - let (_,_,_,matches) = url =~ "^https://([^/]+)/?.*$" :: (Text,Text,Text,[Text]) - in case matches of - [domain] -> Just domain - _ -> Nothing + case parseUri url of + Nothing -> Nothing + Just (_,domain,_) -> Just domain + + + parseUri :: Text -> Maybe (Text, Text, Text) parseUri uri = - let (_,_,_,matches) = uri =~ "^([a-zA-Z0-9]+)://([^/]+)(/?.*)$" :: (Text,Text,Text,[Text]) - in case matches of - [schema, domain, rest] -> Just (schema, domain, rest) - _ -> Nothing + case parseURI (unpack uri) of + Nothing -> Nothing + Just parsedUri -> case uriAuthority parsedUri of + Nothing -> Nothing + -- https: + Just uriAuth -> Just (T.replace (fromString ":") (fromString "") (fromString (uriScheme parsedUri )), + -- //anonymous@ www.haskell.org :42 + fromString(uriUserInfo uriAuth++uriRegName uriAuth ++ uriPort uriAuth), + -- /ghc ?query #frag + fromString(uriPath parsedUri ++ uriQuery parsedUri ++ uriFragment parsedUri)) + data SubstError = SchemaDoesNotExist Text diff --git a/walint.cabal b/walint.cabal index 00b772b..414f9e2 100644 --- a/walint.cabal +++ b/walint.cabal @@ -57,7 +57,8 @@ library witherable, dotgen, text-metrics, - uri-encode + uri-encode, + network-uri -- TODO: move more stuff into lib, these dependencies are silly executable walint |