-- | This module contains the 'Site' 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 'Host') is \"bl.mailspike.net\", the -- return code pattern is \"127.0.0.[2;10;11]\", and the weight is -- \"2". -- module Network.DNS.RBL.Site ( Site(..), site_tests, 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.Host ( Host, host ) 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 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 Site = Site Host (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 Site where pretty_show (Site 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 'Site'. -- -- ==== _Examples_ -- -- >>> import Text.Parsec ( parse ) -- -- >>> let spamhaus = "zen.spamhaus.org*3" -- >>> pretty_print $ parse site "" spamhaus -- zen.spamhaus.org*3 -- -- >>> let mailspike = "bl.mailspike.net=127.0.0.[2;10;11]*2" -- >>> pretty_print $ parse 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 site "" hostkarma -- hostkarma.junkemailfilter.com=127.0.0.2*1 -- -- >>> let ubl = "ubl.unsubscore.com" -- >>> pretty_print $ parse site "" ubl -- ubl.unsubscore.com*1 -- site :: Parser Site site = do d <- host return_codes <- optionMaybe $ char '=' >> v4pattern w <- weight return $ Site d return_codes w -- | Parse more than one 'Site', 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 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 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 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 sites "" bl_list -- ["zen.spamhaus.org*3","bl.mailspike.net=127.0.0.[2;10;11]*2"] -- sites :: Parser [Site] sites = site `sepBy1` many1 (choice [char ',', space]) -- * Tests site_tests :: TestTree site_tests = testGroup "Site 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 'Site'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 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" ] ++ "\"]"