Replace 'UserDomain' with 'Host' in the library.
[dead/harbl.git] / harbl / src / Network / DNS / RBL / Host.hs
1 module Network.DNS.RBL.Host
2 where
3
4 import Data.ByteString.Char8 (
5 intercalate,
6 pack,
7 split )
8 import qualified Network.DNS as DNS ( Domain )
9 import Text.Parsec (
10 (<|>),
11 char,
12 try )
13 import Text.Parsec.String ( Parser )
14
15 import Network.DNS.RBL.Domain ( Domain, domain )
16 import Network.DNS.RBL.Pretty ( Pretty(..) )
17
18
19 -- | This type helps clarify some murkiness in the DNS \"domain\" name
20 -- specification. In RFC1034, it is acknowledged that a domain name
21 -- input with a trailing \".\" will represent an absolute domain
22 -- name (i.e. with respect to the DNS root). However, the grammar in
23 -- RFC1035 disallows a trailing dot.
24 --
25 -- This makes some sense: within the DNS, everything knows its
26 -- position in the tree. The relative/absolute distinction only
27 -- makes sense on the client side, where a user's resolver might
28 -- decide to append some suffix to a relative
29 -- request. Unfortunately, that's where we live. So we have to deal
30 -- with the possibility of having a trailing dot at the end of any
31 -- domain name.
32 --
33 data Host =
34 HostRelative Domain |
35 HostAbsolute Domain
36 deriving (Eq, Show)
37
38 instance Pretty Host where
39 pretty_show (HostRelative d) = pretty_show d
40 pretty_show (HostAbsolute d) = (pretty_show d) ++ "."
41
42
43 -- | Parse a 'Host'. This is what we'll be using to read user
44 -- input, since it supports both relative and absolute domain names
45 -- (unlike the implicitly-absolute 'Domain').
46 --
47 -- ==== _Examples_
48 --
49 -- >>> import Text.Parsec ( parse, parseTest )
50 --
51 -- We can really parse the root now!
52 --
53 -- >>> parseTest user_domain "."
54 -- HostAbsolute DomainRoot
55 --
56 -- But multiple dots aren't (only the first):
57 --
58 -- >>> pretty_print $ parse user_domain "" ".."
59 -- .
60 --
61 -- We can also optionally have a trailing dot at the end of a
62 -- non-empty name:
63 --
64 -- >>> pretty_print $ parse user_domain "" "www.example.com"
65 -- www.example.com
66 --
67 -- >>> pretty_print $ parse user_domain "" "www.example.com."
68 -- www.example.com.
69 --
70 -- A \"relative root\" can also be parsed, letting the user's
71 -- resolver deal with it:
72 --
73 -- >>> parseTest user_domain ""
74 -- HostRelative DomainRoot
75 --
76 host :: Parser Host
77 host = try absolute <|> relative
78 where
79 absolute :: Parser Host
80 absolute = do
81 d <- domain
82 _ <- char '.'
83 return $ HostAbsolute d
84
85 relative :: Parser Host
86 relative = fmap HostRelative domain
87
88
89
90 -- | Reverse the labels of this host in preparation for making a
91 -- lookup (using the DNS library). We need to reverse the labels
92 -- (the stuff between the dots) whether we're looking up a host or a
93 -- name. The only tricky part here is that we need to turn an
94 -- absolute 'Host' into a relative one.
95 --
96 -- ==== _Examples_
97 --
98 -- >>> import Text.Parsec ( parse )
99 --
100 -- >>> let (Right r) = parse host "" "1.2.3.4"
101 -- >>> reverse_labels r
102 -- "4.3.2.1"
103 --
104 -- >>> let (Right r) = parse host "" "www.example.com"
105 -- >>> reverse_labels r
106 -- "com.example.www"
107 --
108 -- Make sure absolute names are made relative:
109 --
110 -- >>> let (Right r) = parse host "" "www.example.com."
111 -- >>> reverse_labels r
112 -- "com.example.www"
113 --
114 reverse_labels :: Host -> DNS.Domain
115 reverse_labels h = reversed
116 where
117 -- | It's possible that we are given an absolute domain name to
118 -- look up. This is legit; say I want to look up
119 -- \"www.example.com.\" That's fine, but before we make the
120 -- actual query we'll need to make it relative and then append
121 -- the DNSBL's suffix to it.
122 relative_host_string :: String
123 relative_host_string =
124 case h of
125 (HostRelative _) -> pretty_show h
126 (HostAbsolute d) -> pretty_show d
127
128 dot = pack "."
129 labels = split '.' (pack relative_host_string)
130 reversed = intercalate dot (reverse labels)