X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Fharbl.git;a=blobdiff_plain;f=harbl%2Fsrc%2FNetwork%2FDNS%2FRBL.hs;h=c16690154ef708815481cd0e306ebbf237ae4a3b;hp=c3268fd894ac8c1f3f151393f0739a63eb012adf;hb=349c5a80e0b729b0e030a1ff3e47667d8afa0d36;hpb=b55e5db2a68be5d69b970bbe4b5ad447881abd3d diff --git a/harbl/src/Network/DNS/RBL.hs b/harbl/src/Network/DNS/RBL.hs index c3268fd..c166901 100644 --- a/harbl/src/Network/DNS/RBL.hs +++ b/harbl/src/Network/DNS/RBL.hs @@ -14,6 +14,7 @@ import Data.IP ( IPv4 ) import Data.List ( intercalate ) import Data.Maybe ( catMaybes ) import Network.DNS ( + Domain, DNSError, Resolver, defaultResolvConf, @@ -21,9 +22,10 @@ import Network.DNS ( makeResolvSeed, withResolver ) -import Network.DNS.RBL.Host ( Host, host, reverse_labels ) +import Network.DNS.RBL.Host ( Host(..), host ) import Network.DNS.RBL.IPv4Pattern ( addresses ) import Network.DNS.RBL.Pretty ( Pretty(..) ) +import Network.DNS.RBL.Reversible ( Reversible(..) ) import Network.DNS.RBL.Site ( Site(..), sites ) @@ -49,6 +51,20 @@ listing_message (ListingDetails h (Site d _ w) codes) = return_codes = intercalate "," (map show codes) +-- | Make the given 'Host' relative (if it was absolute), and reverse +-- its labels. This is done in order to look it up in the DNS in +-- standard reverse lookup form. For example, if we wanted to look +-- up @192.168.0.1@ on @rbl.example.com@, we would want to look up +-- the name @1.0.168.192.rbl.example.com@. +-- +reverse_host :: Host -> Domain +reverse_host h = + pack $ case (backwards h) of + (HostRelative _) -> pretty_show h + (HostAbsolute d) -> pretty_show d + + + -- | This code is stolen from 'Network.DNS.lookupRDNS', which I'm -- pretty sure I wrote anyway. -- @@ -56,7 +72,7 @@ dnslookup :: Resolver -> Host -> Host -> IO (Either DNSError [IPv4]) dnslookup rlv rbl h = lookupA rlv dom where suffix = pack $ "." ++ (pretty_show rbl) - dom = (reverse_labels h) `append` suffix + dom = (reverse_host h) `append` suffix -- | See 'lookup_single'. The \"prime\" version here takes an