--- /dev/null
+-- | This module contains the 'DnsblSite' data type representing one
+-- blacklist with its associated return codes and weight. For example,
+-- in Postfix's main.cf you might have,
+--
+-- postscreen_dnsbl_sites = bl.mailspike.net=127.0.0.[2;10;11]*2, ...
+--
+-- Here, the blacklist (a 'UserDomain') is \"bl.mailspike.net\", the
+-- return code pattern is \"127.0.0.[2;10;11]\", and the weight is
+-- \"2".
+--
+module Network.DNS.RBL.DnsblSite (
+ dnsbl_site_tests,
+ dnsbl_sites )
+where
+
+import Data.List ( intercalate )
+import Test.Tasty ( TestTree, testGroup )
+import Test.Tasty.HUnit ( (@?=), testCase )
+import Text.Parsec (
+ (<|>),
+ char,
+ choice,
+ digit,
+ many1,
+ option,
+ optionMaybe,
+ parse,
+ sepBy1,
+ space,
+ try,
+ unexpected )
+import Text.Parsec.String ( Parser )
+import Text.Read ( readMaybe )
+
+import Network.DNS.RBL.Domain ( UserDomain, user_domain )
+import Network.DNS.RBL.IPv4Pattern ( IPv4Pattern, v4pattern )
+import Network.DNS.RBL.Pretty ( Pretty(..) )
+
+
+newtype Weight = Weight Int deriving (Eq, Show)
+
+instance Pretty Weight where
+ pretty_show (Weight w) = show w
+
+
+-- | Parse the weight multiplier at the end of a dnsbl_site.
+--
+-- ==== _Examples_
+--
+-- >>> import Text.Parsec ( parseTest )
+--
+-- Negative, zero, and positive integers are all supported:
+--
+-- >>> parseTest weight "*-5"
+-- Weight (-5)
+--
+-- >>> parseTest weight "*0"
+-- Weight 0
+--
+-- >>> parseTest weight "*17"
+-- Weight 17
+--
+-- If the weight is empty, it defaults to @1@:
+--
+-- >>> parseTest weight ""
+-- Weight 1
+--
+-- The default is used whenever parsing fails:
+--
+-- >>> parseTest weight "*hello"
+-- Weight 1
+--
+-- The 'Pretty' instance works as intended:
+--
+-- >>> import Text.Parsec ( parse )
+-- >>> pretty_print $ parse weight "" "*3"
+-- 3
+--
+weight :: Parser Weight
+weight = try parse_weight <|> return (Weight 1)
+ where
+ parse_weight = do
+ _ <- char '*'
+ sign <- (char '-') <|> (option '+' (char '+'))
+ w <- many1 digit
+ case ( readMaybe w :: Maybe Int ) of
+ -- If "many1 digit" gives us a list of digits, we should be able
+ -- to convert that to an Int! It will overflow rather than fail
+ -- if the input is too big/small, so it should really always
+ -- succeed.
+ Nothing -> unexpected "weight: readMaybe failed on a sequence of digits!"
+ Just k -> return $ Weight (if sign == '-' then negate k else k)
+
+
+
+-- | A DNSBL as it would be input into postfix. It has a blacklist
+-- (DNS) name, a pattern of addresses to use for a \"hit\", and a
+-- weight multiplier.
+--
+data DnsblSite = DnsblSite UserDomain (Maybe IPv4Pattern) Weight
+
+
+-- | Pretty print DNSBL sites. This is straightforward except for the
+-- weight. We default to a weight of @1@, but this leaves us with a
+-- choice. If the user leaves off the weight, do we want to
+-- pretty-print it as @1@? How about if we explicitly writes the
+-- \"*1\" multiplier?
+--
+-- The pretty-printing isn't user-facing, really, so it makes sense
+-- to just choose one of these behaviors rather than pass around a
+-- @Maybe Weight@. We always print the multiplier, even when it's @1@.
+--
+instance Pretty DnsblSite where
+ pretty_show (DnsblSite d p w) =
+ (pretty_show d) ++ pattern_string ++ "*" ++ (pretty_show w)
+ where
+ pattern_string = case p of
+ Nothing -> ""
+ Just pat -> "=" ++ pretty_show pat
+
+
+-- | Parse a single 'DnsblSite'.
+--
+-- ==== _Examples_
+--
+-- >>> import Text.Parsec ( parse )
+--
+-- >>> let spamhaus = "zen.spamhaus.org*3"
+-- >>> pretty_print $ parse dnsbl_site "" spamhaus
+-- zen.spamhaus.org*3
+--
+-- >>> let mailspike = "bl.mailspike.net=127.0.0.[2;10;11]*2"
+-- >>> pretty_print $ parse dnsbl_site "" mailspike
+-- bl.mailspike.net=127.0.0.[2;10;11]*2
+--
+-- If the weight is left unspecified, it defaults to \"1\" which is
+-- then printed:
+--
+-- >>> let hostkarma = "hostkarma.junkemailfilter.com=127.0.0.2"
+-- >>> pretty_print $ parse dnsbl_site "" hostkarma
+-- hostkarma.junkemailfilter.com=127.0.0.2*1
+--
+-- >>> let ubl = "ubl.unsubscore.com"
+-- >>> pretty_print $ parse dnsbl_site "" ubl
+-- ubl.unsubscore.com*1
+--
+dnsbl_site :: Parser DnsblSite
+dnsbl_site = do
+ d <- user_domain
+ return_codes <- optionMaybe $ char '=' >> v4pattern
+ w <- weight
+ return $ DnsblSite d return_codes w
+
+
+-- | Parse more than one 'DnsblSite', separated by commas and/or
+-- whitespace.
+--
+-- ==== _Examples_
+--
+-- >>> import Text.Parsec ( parse )
+--
+-- Any combination of comma/spaces can be used as a separator:
+--
+-- >>> let spamhaus = "zen.spamhaus.org*3"
+-- >>> let mailspike = "bl.mailspike.net=127.0.0.[2;10;11]*2"
+-- >>> let bl_list = spamhaus ++ "," ++ mailspike
+-- >>> pretty_print $ parse dnsbl_sites "" bl_list
+-- ["zen.spamhaus.org*3","bl.mailspike.net=127.0.0.[2;10;11]*2"]
+-- >>> let bl_list = spamhaus ++ " , " ++ mailspike
+-- >>> pretty_print $ parse dnsbl_sites "" bl_list
+-- ["zen.spamhaus.org*3","bl.mailspike.net=127.0.0.[2;10;11]*2"]
+-- >>> let bl_list = spamhaus ++ " " ++ mailspike
+-- >>> pretty_print $ parse dnsbl_sites "" bl_list
+-- ["zen.spamhaus.org*3","bl.mailspike.net=127.0.0.[2;10;11]*2"]
+--
+-- Any whitespace, in fact, should work:
+--
+-- >>> let spamhaus = "zen.spamhaus.org*3"
+-- >>> let mailspike = "bl.mailspike.net=127.0.0.[2;10;11]*2"
+-- >>> let bl_list = spamhaus ++ "\n,\t \t\r" ++ mailspike
+-- >>> pretty_print $ parse dnsbl_sites "" bl_list
+-- ["zen.spamhaus.org*3","bl.mailspike.net=127.0.0.[2;10;11]*2"]
+--
+dnsbl_sites :: Parser [DnsblSite]
+dnsbl_sites = dnsbl_site `sepBy1` many1 (choice [char ',', space])
+
+
+
+-- * Tests
+
+dnsbl_site_tests :: TestTree
+dnsbl_site_tests =
+ testGroup
+ "DnsblSite tests"
+ [ test_full_maincf_sites_parsed ]
+
+
+-- | This is a sample \"postscreen_dnsbl_sites\" from a real main.cf.
+-- We should be able to parse it as a list of 'DnsblSite's.
+--
+test_full_maincf_sites_parsed :: TestTree
+test_full_maincf_sites_parsed =
+ testCase "a full main.cf list of postscreen_dnsbl_sites is parsed" $ do
+ -- Whatever, it's a test.
+ let actual = pretty_show $ parse dnsbl_sites "" input
+ actual @?= expected
+ where
+ input = intercalate ",\n\t" [
+ "zen.spamhaus.org*3",
+ "b.barracudacentral.org*3",
+ "sip.invaluement.invalid*3",
+ "jerks.viabit.com*3",
+ "bl.mailspike.net=127.0.0.[2;10;11]*2",
+ "bl.spamcop.net*2",
+ "psbl.surriel.com*2",
+ "bl.mailspike.net=127.0.0.12*2",
+ "bl.spameatingmonkey.net*2",
+ "db.wpbl.info*2",
+ "dnsbl.sorbs.net",
+ "dnsbl-1.uceprotect.net",
+ "hostkarma.junkemailfilter.com=127.0.0.2",
+ "ubl.unsubscore.com",
+ "dnsbl.zapbl.net" ]
+
+ -- We expect the "one" multipliers to have been added, and the
+ -- quotation marks to be added...
+ expected = "[\"" ++
+ intercalate "\",\"" [
+ "zen.spamhaus.org*3",
+ "b.barracudacentral.org*3",
+ "sip.invaluement.invalid*3",
+ "jerks.viabit.com*3",
+ "bl.mailspike.net=127.0.0.[2;10;11]*2",
+ "bl.spamcop.net*2",
+ "psbl.surriel.com*2",
+ "bl.mailspike.net=127.0.0.12*2",
+ "bl.spameatingmonkey.net*2",
+ "db.wpbl.info*2",
+ "dnsbl.sorbs.net*1",
+ "dnsbl-1.uceprotect.net*1",
+ "hostkarma.junkemailfilter.com=127.0.0.2*1",
+ "ubl.unsubscore.com*1",
+ "dnsbl.zapbl.net*1" ]
+ ++ "\"]"
projects / dead / harbl.git / blobdiff