module Network.DNS.RBL.Host where import Data.ByteString.Char8 ( intercalate, pack, split ) import qualified Network.DNS as DNS ( Domain ) import Text.Parsec ( (<|>), char, try ) import Text.Parsec.String ( Parser ) import Network.DNS.RBL.Domain ( Domain, domain ) import Network.DNS.RBL.Pretty ( Pretty(..) ) -- | This type helps clarify some murkiness in the DNS \"domain\" name -- specification. In RFC1034, it is acknowledged that a domain name -- input with a trailing \".\" will represent an absolute domain -- name (i.e. with respect to the DNS root). However, the grammar in -- RFC1035 disallows a trailing dot. -- -- This makes some sense: within the DNS, everything knows its -- position in the tree. The relative/absolute distinction only -- makes sense on the client side, where a user's resolver might -- decide to append some suffix to a relative -- request. Unfortunately, that's where we live. So we have to deal -- with the possibility of having a trailing dot at the end of any -- domain name. -- data Host = HostRelative Domain | HostAbsolute Domain deriving (Eq, Show) instance Pretty Host where pretty_show (HostRelative d) = pretty_show d pretty_show (HostAbsolute d) = (pretty_show d) ++ "." -- | Parse a 'Host'. This is what we'll be using to read user -- input, since it supports both relative and absolute domain names -- (unlike the implicitly-absolute 'Domain'). -- -- ==== _Examples_ -- -- >>> import Text.Parsec ( parse, parseTest ) -- -- We can really parse the root now! -- -- >>> parseTest user_domain "." -- HostAbsolute DomainRoot -- -- But multiple dots aren't (only the first): -- -- >>> pretty_print $ parse user_domain "" ".." -- . -- -- We can also optionally have a trailing dot at the end of a -- non-empty name: -- -- >>> pretty_print $ parse user_domain "" "www.example.com" -- www.example.com -- -- >>> pretty_print $ parse user_domain "" "www.example.com." -- www.example.com. -- -- A \"relative root\" can also be parsed, letting the user's -- resolver deal with it: -- -- >>> parseTest user_domain "" -- HostRelative DomainRoot -- host :: Parser Host host = try absolute <|> relative where absolute :: Parser Host absolute = do d <- domain _ <- char '.' return $ HostAbsolute d relative :: Parser Host relative = fmap HostRelative domain -- | Reverse the labels of this host in preparation for making a -- lookup (using the DNS library). We need to reverse the labels -- (the stuff between the dots) whether we're looking up a host or a -- name. The only tricky part here is that we need to turn an -- absolute 'Host' into a relative one. -- -- ==== _Examples_ -- -- >>> import Text.Parsec ( parse ) -- -- >>> let (Right r) = parse host "" "1.2.3.4" -- >>> reverse_labels r -- "4.3.2.1" -- -- >>> let (Right r) = parse host "" "www.example.com" -- >>> reverse_labels r -- "com.example.www" -- -- Make sure absolute names are made relative: -- -- >>> let (Right r) = parse host "" "www.example.com." -- >>> reverse_labels r -- "com.example.www" -- reverse_labels :: Host -> DNS.Domain reverse_labels h = reversed where -- | It's possible that we are given an absolute domain name to -- look up. This is legit; say I want to look up -- \"www.example.com.\" That's fine, but before we make the -- actual query we'll need to make it relative and then append -- the DNSBL's suffix to it. relative_host_string :: String relative_host_string = case h of (HostRelative _) -> pretty_show h (HostAbsolute d) -> pretty_show d dot = pack "." labels = split '.' (pack relative_host_string) reversed = intercalate dot (reverse labels)