Replace 'UserDomain' with 'Host' in the library.

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

diff --git a/src/Network/DNS/RBL.hs b/harbl/src/Network/DNS/RBL.hs
similarity index 55%
rename from src/Network/DNS/RBL.hs
rename to harbl/src/Network/DNS/RBL.hs
index 3c32e5d97b990d654b92bf1e5ad40279b529c65e..c3268fd894ac8c1f3f151393f0739a63eb012adf 100644 (file)
--- a/src/Network/DNS/RBL.hs
+++ b/harbl/src/Network/DNS/RBL.hs
@@ -1,4 +1,12 @@
-module Network.DNS.RBL ( lookup_single )
+{-# LANGUAGE DoAndIfThenElse #-}
+
+module Network.DNS.RBL (
+  Host,
+  Site,
+  host,
+  listing_message,
+  lookup_rbl,
+  sites )

 where
 
 import Data.ByteString.Char8 ( append, pack )
 where
 
 import Data.ByteString.Char8 ( append, pack )


@@ -13,27 +21,26 @@ import Network.DNS (
   makeResolvSeed,
   withResolver )
 
   makeResolvSeed,
   withResolver )
 

-import Network.DNS.RBL.Domain ( UserDomain )
-import Network.DNS.RBL.Host ( Host, reverse_labels )
+import Network.DNS.RBL.Host ( Host, host, reverse_labels )

 import Network.DNS.RBL.IPv4Pattern ( addresses )
 import Network.DNS.RBL.Pretty ( Pretty(..) )
 import Network.DNS.RBL.IPv4Pattern ( addresses )
 import Network.DNS.RBL.Pretty ( Pretty(..) )

-import Network.DNS.RBL.Site ( Site(..), Weight(..) )
+import Network.DNS.RBL.Site ( Site(..), sites )

 
 
 
 -- | In most applications, you will want to know /why/ a host is
 
 
 
 -- | In most applications, you will want to know /why/ a host is

---   blacklisted. This type stores those details: the site on which
---   the host was listed, and the return codes that we got back from
---   the blacklist.
-data ListingDetails = ListingDetails Site [IPv4]
+--   blacklisted. This type stores those details: the host itself, the
+--   site on which the host was listed, and the return codes that we
+--   got back from the blacklist.
+data ListingDetails = ListingDetails Host Site [IPv4]

 
 
 -- | Create a nice \"error\" message from a host and the details of
 --   why it was listed.
 --
 
 
 -- | Create a nice \"error\" message from a host and the details of
 --   why it was listed.
 --

-listing_message :: Host -> ListingDetails -> String
-listing_message host (ListingDetails (Site d _ w) codes) =
-  "host " ++ (pretty_show host) ++ " " ++
+listing_message :: ListingDetails -> String
+listing_message (ListingDetails h (Site d _ w) codes) =
+  "host " ++ (pretty_show h) ++ " " ++

   "listed on " ++ (pretty_show d) ++ " " ++
   "with return code(s) " ++ return_codes ++ " " ++
   "having weight " ++ (pretty_show w)
   "listed on " ++ (pretty_show d) ++ " " ++
   "with return code(s) " ++ return_codes ++ " " ++
   "having weight " ++ (pretty_show w)


@@ -45,11 +52,11 @@ listing_message host (ListingDetails (Site d _ w) codes) =
 -- | This code is stolen from 'Network.DNS.lookupRDNS', which I'm
 --   pretty sure I wrote anyway.
 --
 -- | This code is stolen from 'Network.DNS.lookupRDNS', which I'm
 --   pretty sure I wrote anyway.
 --

-dnslookup :: Resolver -> UserDomain -> Host -> IO (Either DNSError [IPv4])
-dnslookup rlv rbl host = lookupA rlv dom
+dnslookup :: Resolver -> Host -> Host -> IO (Either DNSError [IPv4])
+dnslookup rlv rbl h = lookupA rlv dom

   where
     suffix = pack $ "." ++ (pretty_show rbl)
   where
     suffix = pack $ "." ++ (pretty_show rbl)

-    dom = (reverse_labels host) `append` suffix
+    dom = (reverse_labels h) `append` suffix

 
 
 -- | See 'lookup_single'. The \"prime\" version here takes an
 
 
 -- | See 'lookup_single'. The \"prime\" version here takes an


@@ -59,37 +66,26 @@ lookup_single' :: Resolver
                -> Host
                -> Site
                -> IO (Maybe ListingDetails)
                -> Host
                -> Site
                -> IO (Maybe ListingDetails)

-lookup_single' resolver host site@(Site d p (Weight w)) = do
-  response <- dnslookup resolver d host
+lookup_single' resolver h site@(Site d p _) = do
+  response <- dnslookup resolver d h

   case response of
     Left _ -> return Nothing -- Not listed, no error to report
     Right ipv4s ->
       case p of
         -- No pattern given, but we got a hit.
   case response of
     Left _ -> return Nothing -- Not listed, no error to report
     Right ipv4s ->
       case p of
         -- No pattern given, but we got a hit.

-        Nothing -> return $ Just (ListingDetails site ipv4s)
+        Nothing -> return $ Just (ListingDetails h site ipv4s)

         Just pat -> do
           let ipv4_strings = map show ipv4s
           let codes = addresses pat
           let hits = map (`elem` codes) ipv4_strings
           if or hits -- if any of the returned addresses match the pattern
         Just pat -> do
           let ipv4_strings = map show ipv4s
           let codes = addresses pat
           let hits = map (`elem` codes) ipv4_strings
           if or hits -- if any of the returned addresses match the pattern

-          then return $ Just (ListingDetails site ipv4s)
+          then return $ Just (ListingDetails h site ipv4s)

           else return Nothing
 
 
           else return Nothing
 
 

--- | Look up a single...
-lookup_single :: Host
-              -> Site
-              -> IO (Maybe ListingDetails)
-lookup_single host site = do
-  rs <- makeResolvSeed defaultResolvConf
-  withResolver rs $ \resolver -> lookup_single' resolver host site
-
-
-lookup :: Host -> [Site] -> IO [ListingDetails]
-lookup host sites = do
+lookup_rbl :: [Site] -> Host -> IO [ListingDetails]
+lookup_rbl rbl_sites h = do

   rs <- makeResolvSeed defaultResolvConf
   withResolver rs $ \resolver -> do
   rs <- makeResolvSeed defaultResolvConf
   withResolver rs $ \resolver -> do

-    results <- mapM (lookup_single' resolver host) sites
+    results <- mapM (lookup_single' resolver h) rbl_sites

     return $ catMaybes results
     return $ catMaybes results

-
-