Rename everything under the Network.DNS.RBL hierarchy.
[dead/harbl.git] / src / Network / DNS / RBL / DnsblSite.hs
1 -- | This module contains the 'DnsblSite' data type representing one
2 -- blacklist with its associated return codes and weight. For example,
3 -- in Postfix's main.cf you might have,
4 --
5 -- postscreen_dnsbl_sites = bl.mailspike.net=127.0.0.[2;10;11]*2, ...
6 --
7 -- Here, the blacklist (a 'UserDomain') is \"bl.mailspike.net\", the
8 -- return code pattern is \"127.0.0.[2;10;11]\", and the weight is
9 -- \"2".
10 --
11 module Network.DNS.RBL.DnsblSite (
12 dnsbl_site_tests,
13 dnsbl_sites )
14 where
15
16 import Data.List ( intercalate )
17 import Test.Tasty ( TestTree, testGroup )
18 import Test.Tasty.HUnit ( (@?=), testCase )
19 import Text.Parsec (
20 (<|>),
21 char,
22 choice,
23 digit,
24 many1,
25 option,
26 optionMaybe,
27 parse,
28 sepBy1,
29 space,
30 try,
31 unexpected )
32 import Text.Parsec.String ( Parser )
33 import Text.Read ( readMaybe )
34
35 import Network.DNS.RBL.Domain ( UserDomain, user_domain )
36 import Network.DNS.RBL.IPv4Pattern ( IPv4Pattern, v4pattern )
37 import Network.DNS.RBL.Pretty ( Pretty(..) )
38
39
40 newtype Weight = Weight Int deriving (Eq, Show)
41
42 instance Pretty Weight where
43 pretty_show (Weight w) = show w
44
45
46 -- | Parse the weight multiplier at the end of a dnsbl_site.
47 --
48 -- ==== _Examples_
49 --
50 -- >>> import Text.Parsec ( parseTest )
51 --
52 -- Negative, zero, and positive integers are all supported:
53 --
54 -- >>> parseTest weight "*-5"
55 -- Weight (-5)
56 --
57 -- >>> parseTest weight "*0"
58 -- Weight 0
59 --
60 -- >>> parseTest weight "*17"
61 -- Weight 17
62 --
63 -- If the weight is empty, it defaults to @1@:
64 --
65 -- >>> parseTest weight ""
66 -- Weight 1
67 --
68 -- The default is used whenever parsing fails:
69 --
70 -- >>> parseTest weight "*hello"
71 -- Weight 1
72 --
73 -- The 'Pretty' instance works as intended:
74 --
75 -- >>> import Text.Parsec ( parse )
76 -- >>> pretty_print $ parse weight "" "*3"
77 -- 3
78 --
79 weight :: Parser Weight
80 weight = try parse_weight <|> return (Weight 1)
81 where
82 parse_weight = do
83 _ <- char '*'
84 sign <- (char '-') <|> (option '+' (char '+'))
85 w <- many1 digit
86 case ( readMaybe w :: Maybe Int ) of
87 -- If "many1 digit" gives us a list of digits, we should be able
88 -- to convert that to an Int! It will overflow rather than fail
89 -- if the input is too big/small, so it should really always
90 -- succeed.
91 Nothing -> unexpected "weight: readMaybe failed on a sequence of digits!"
92 Just k -> return $ Weight (if sign == '-' then negate k else k)
93
94
95
96 -- | A DNSBL as it would be input into postfix. It has a blacklist
97 -- (DNS) name, a pattern of addresses to use for a \"hit\", and a
98 -- weight multiplier.
99 --
100 data DnsblSite = DnsblSite UserDomain (Maybe IPv4Pattern) Weight
101
102
103 -- | Pretty print DNSBL sites. This is straightforward except for the
104 -- weight. We default to a weight of @1@, but this leaves us with a
105 -- choice. If the user leaves off the weight, do we want to
106 -- pretty-print it as @1@? How about if we explicitly writes the
107 -- \"*1\" multiplier?
108 --
109 -- The pretty-printing isn't user-facing, really, so it makes sense
110 -- to just choose one of these behaviors rather than pass around a
111 -- @Maybe Weight@. We always print the multiplier, even when it's @1@.
112 --
113 instance Pretty DnsblSite where
114 pretty_show (DnsblSite d p w) =
115 (pretty_show d) ++ pattern_string ++ "*" ++ (pretty_show w)
116 where
117 pattern_string = case p of
118 Nothing -> ""
119 Just pat -> "=" ++ pretty_show pat
120
121
122 -- | Parse a single 'DnsblSite'.
123 --
124 -- ==== _Examples_
125 --
126 -- >>> import Text.Parsec ( parse )
127 --
128 -- >>> let spamhaus = "zen.spamhaus.org*3"
129 -- >>> pretty_print $ parse dnsbl_site "" spamhaus
130 -- zen.spamhaus.org*3
131 --
132 -- >>> let mailspike = "bl.mailspike.net=127.0.0.[2;10;11]*2"
133 -- >>> pretty_print $ parse dnsbl_site "" mailspike
134 -- bl.mailspike.net=127.0.0.[2;10;11]*2
135 --
136 -- If the weight is left unspecified, it defaults to \"1\" which is
137 -- then printed:
138 --
139 -- >>> let hostkarma = "hostkarma.junkemailfilter.com=127.0.0.2"
140 -- >>> pretty_print $ parse dnsbl_site "" hostkarma
141 -- hostkarma.junkemailfilter.com=127.0.0.2*1
142 --
143 -- >>> let ubl = "ubl.unsubscore.com"
144 -- >>> pretty_print $ parse dnsbl_site "" ubl
145 -- ubl.unsubscore.com*1
146 --
147 dnsbl_site :: Parser DnsblSite
148 dnsbl_site = do
149 d <- user_domain
150 return_codes <- optionMaybe $ char '=' >> v4pattern
151 w <- weight
152 return $ DnsblSite d return_codes w
153
154
155 -- | Parse more than one 'DnsblSite', separated by commas and/or
156 -- whitespace.
157 --
158 -- ==== _Examples_
159 --
160 -- >>> import Text.Parsec ( parse )
161 --
162 -- Any combination of comma/spaces can be used as a separator:
163 --
164 -- >>> let spamhaus = "zen.spamhaus.org*3"
165 -- >>> let mailspike = "bl.mailspike.net=127.0.0.[2;10;11]*2"
166 -- >>> let bl_list = spamhaus ++ "," ++ mailspike
167 -- >>> pretty_print $ parse dnsbl_sites "" bl_list
168 -- ["zen.spamhaus.org*3","bl.mailspike.net=127.0.0.[2;10;11]*2"]
169 -- >>> let bl_list = spamhaus ++ " , " ++ mailspike
170 -- >>> pretty_print $ parse dnsbl_sites "" bl_list
171 -- ["zen.spamhaus.org*3","bl.mailspike.net=127.0.0.[2;10;11]*2"]
172 -- >>> let bl_list = spamhaus ++ " " ++ mailspike
173 -- >>> pretty_print $ parse dnsbl_sites "" bl_list
174 -- ["zen.spamhaus.org*3","bl.mailspike.net=127.0.0.[2;10;11]*2"]
175 --
176 -- Any whitespace, in fact, should work:
177 --
178 -- >>> let spamhaus = "zen.spamhaus.org*3"
179 -- >>> let mailspike = "bl.mailspike.net=127.0.0.[2;10;11]*2"
180 -- >>> let bl_list = spamhaus ++ "\n,\t \t\r" ++ mailspike
181 -- >>> pretty_print $ parse dnsbl_sites "" bl_list
182 -- ["zen.spamhaus.org*3","bl.mailspike.net=127.0.0.[2;10;11]*2"]
183 --
184 dnsbl_sites :: Parser [DnsblSite]
185 dnsbl_sites = dnsbl_site `sepBy1` many1 (choice [char ',', space])
186
187
188
189 -- * Tests
190
191 dnsbl_site_tests :: TestTree
192 dnsbl_site_tests =
193 testGroup
194 "DnsblSite tests"
195 [ test_full_maincf_sites_parsed ]
196
197
198 -- | This is a sample \"postscreen_dnsbl_sites\" from a real main.cf.
199 -- We should be able to parse it as a list of 'DnsblSite's.
200 --
201 test_full_maincf_sites_parsed :: TestTree
202 test_full_maincf_sites_parsed =
203 testCase "a full main.cf list of postscreen_dnsbl_sites is parsed" $ do
204 -- Whatever, it's a test.
205 let actual = pretty_show $ parse dnsbl_sites "" input
206 actual @?= expected
207 where
208 input = intercalate ",\n\t" [
209 "zen.spamhaus.org*3",
210 "b.barracudacentral.org*3",
211 "sip.invaluement.invalid*3",
212 "jerks.viabit.com*3",
213 "bl.mailspike.net=127.0.0.[2;10;11]*2",
214 "bl.spamcop.net*2",
215 "psbl.surriel.com*2",
216 "bl.mailspike.net=127.0.0.12*2",
217 "bl.spameatingmonkey.net*2",
218 "db.wpbl.info*2",
219 "dnsbl.sorbs.net",
220 "dnsbl-1.uceprotect.net",
221 "hostkarma.junkemailfilter.com=127.0.0.2",
222 "ubl.unsubscore.com",
223 "dnsbl.zapbl.net" ]
224
225 -- We expect the "one" multipliers to have been added, and the
226 -- quotation marks to be added...
227 expected = "[\"" ++
228 intercalate "\",\"" [
229 "zen.spamhaus.org*3",
230 "b.barracudacentral.org*3",
231 "sip.invaluement.invalid*3",
232 "jerks.viabit.com*3",
233 "bl.mailspike.net=127.0.0.[2;10;11]*2",
234 "bl.spamcop.net*2",
235 "psbl.surriel.com*2",
236 "bl.mailspike.net=127.0.0.12*2",
237 "bl.spameatingmonkey.net*2",
238 "db.wpbl.info*2",
239 "dnsbl.sorbs.net*1",
240 "dnsbl-1.uceprotect.net*1",
241 "hostkarma.junkemailfilter.com=127.0.0.2*1",
242 "ubl.unsubscore.com*1",
243 "dnsbl.zapbl.net*1" ]
244 ++ "\"]"