X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Fharbl.git;a=blobdiff_plain;f=src%2FDnsblSite.hs;fp=src%2FDnsblSite.hs;h=0000000000000000000000000000000000000000;hp=46a872ba4e545695cca2ee7a4558ffa76a38a4ac;hb=bc28c407970d9ff1bfeacc88363fd6d23c0af440;hpb=e093d003defb7948f17927091c3e73a250d53e6c diff --git a/src/DnsblSite.hs b/src/DnsblSite.hs deleted file mode 100644 index 46a872b..0000000 --- a/src/DnsblSite.hs +++ /dev/null @@ -1,244 +0,0 @@ --- | 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 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 Domain ( UserDomain, user_domain ) -import IPv4Pattern ( IPv4Pattern, v4pattern ) -import 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" ] - ++ "\"]"