Add the Reversible class.

[dead/harbl.git] / harbl / src / Network / DNS / RBL.hs

diff --git a/harbl/src/Network/DNS/RBL.hs b/harbl/src/Network/DNS/RBL.hs
index c3268fd894ac8c1f3f151393f0739a63eb012adf..c16690154ef708815481cd0e306ebbf237ae4a3b 100644 (file)
--- 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