+++ /dev/null
-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
-
-