diff options
author | stuebinm | 2021-11-19 01:29:28 +0100 |
---|---|---|
committer | stuebinm | 2021-11-19 01:29:28 +0100 |
commit | 321f4d5fa118515dcde522e1ad01ddd65741828b (patch) | |
tree | aefb3ff2cb96d91059cbf3c16f6f7c81da145a5e /lib/Properties.hs | |
parent | 12025514261f524d7a4ded461709a7d151cc1b36 (diff) |
add domain allow- and blocklists for weblinks
(these use a rather crude regex for parsing, which may be possible to
side-step, and which should probably be replaced by something that was
actually written while following the relevant rfc)
Diffstat (limited to 'lib/Properties.hs')
-rw-r--r-- | lib/Properties.hs | 18 |
1 files changed, 14 insertions, 4 deletions
diff --git a/lib/Properties.hs b/lib/Properties.hs index 74fd72a..3169e4d 100644 --- a/lib/Properties.hs +++ b/lib/Properties.hs @@ -20,7 +20,7 @@ import LintConfig (LintConfig (..)) import LintWriter (LintWriter, adjust, askContext, askFileDepth, complain, dependsOn, forbid, lintConfig, offersEntrypoint, suggest, warn) -import Paths (RelPath (..), parsePath) +import Paths (RelPath (..), parsePath, extractDomain) import Types (Dep (Link, Local, LocalMap, MapLink)) @@ -174,9 +174,19 @@ checkLayerProperty p@(Property name _value) = case name of suggestProperty $ Property "openWebsiteTrigger" (StrProp "onaction") unwrapLink p $ \link -> if "https://" `isPrefixOf` link then do - dependsOn $ Link link - prefix <- lintConfig configLinkPrefix - setProperty "openWebsite" (prefix <> link) + config <- lintConfig id + case extractDomain link of + Just domain + | domain `elem` configBlockedDomains config + -> complain $ "domain " <> domain <> " is blocked." + | domain `elem` configAllowedDomains config + -> dependsOn $ Link link + | otherwise + -> do + dependsOn $ Link link + prefix <- lintConfig configLinkPrefix + setProperty "openWebsite" (prefix <> link) + Nothing -> complain "invalid link?" else unwrapPath link (dependsOn . Local) "openWebsiteTrigger" -> do isString p |