]> gitweb.michael.orlitzky.com - dead/harbl.git/blobdiff - src/Network/DNS/RBL.hs
Replace 'UserDomain' with 'Host' in the library.
[dead/harbl.git] / src / Network / DNS / RBL.hs
diff --git a/src/Network/DNS/RBL.hs b/src/Network/DNS/RBL.hs
deleted file mode 100644 (file)
index 3c32e5d..0000000
+++ /dev/null
@@ -1,95 +0,0 @@
-module Network.DNS.RBL ( lookup_single )
-where
-
-import Data.ByteString.Char8 ( append, pack )
-import Data.IP ( IPv4 )
-import Data.List ( intercalate )
-import Data.Maybe ( catMaybes )
-import Network.DNS (
-  DNSError,
-  Resolver,
-  defaultResolvConf,
-  lookupA,
-  makeResolvSeed,
-  withResolver )
-
-import Network.DNS.RBL.Domain ( UserDomain )
-import Network.DNS.RBL.Host ( Host, reverse_labels )
-import Network.DNS.RBL.IPv4Pattern ( addresses )
-import Network.DNS.RBL.Pretty ( Pretty(..) )
-import Network.DNS.RBL.Site ( Site(..), Weight(..) )
-
-
-
--- | 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]
-
-
--- | 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) ++ " " ++
-  "listed on " ++ (pretty_show d) ++ " " ++
-  "with return code(s) " ++ return_codes ++ " " ++
-  "having weight " ++ (pretty_show w)
-  where
-    return_codes :: String
-    return_codes = intercalate "," (map show codes)
-
-
--- | 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
-  where
-    suffix = pack $ "." ++ (pretty_show rbl)
-    dom = (reverse_labels host) `append` suffix
-
-
--- | See 'lookup_single'. The \"prime\" version here takes an
---   additional @resolver@ argument for performance reasons.
---
-lookup_single' :: Resolver
-               -> Host
-               -> Site
-               -> IO (Maybe ListingDetails)
-lookup_single' resolver host site@(Site d p (Weight w)) = do
-  response <- dnslookup resolver d host
-  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)
-        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)
-          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
-  rs <- makeResolvSeed defaultResolvConf
-  withResolver rs $ \resolver -> do
-    results <- mapM (lookup_single' resolver host) sites
-    return $ catMaybes results
-
-