module Network.DNS.RBL ( lookup_single )
where
-import qualified Data.ByteString.Char8 as BS (
- append,
- intercalate,
- pack,
- split )
+import Data.ByteString.Char8 ( append, pack )
import Data.IP ( IPv4 )
import Data.List ( intercalate )
import Data.Maybe ( catMaybes )
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(..) )
--- | A dumb wrapper around an IP address input as a 'String'.
---
-newtype Host = Host String
-instance Pretty Host where pretty_show (Host h) = h
-- | In most applications, you will want to know /why/ a host is
-- pretty sure I wrote anyway.
--
dnslookup :: Resolver -> UserDomain -> Host -> IO (Either DNSError [IPv4])
-dnslookup rlv rbl (Host ip) = lookupA rlv dom
+dnslookup rlv rbl host = lookupA rlv dom
where
- -- ByteString constants.
- dot = BS.pack "."
- suffix = BS.pack $ "." ++ (pretty_show rbl)
-
- octets = BS.split '.' (BS.pack ip)
- reverse_ip = BS.intercalate dot (reverse octets)
- dom = reverse_ip `BS.append` suffix
-
-
-
--- | Look up the given @host@ on a single RBL, and return the number
--- of \"points\" it scores. If the host is listed, it should score the
--- weight of the given blacklist. Otherwise, it scores zero.
---
-lookup_single :: Host -> Site -> IO Int
-lookup_single host site = do
- rs <- makeResolvSeed defaultResolvConf
- withResolver rs $ \resolver -> lookup_single' resolver host site
-
-
--- | See 'lookup_single'.
---
--- The \"prime\" version of this function takes a pre-existing
--- resolver as an argument for performance reasons.
---
-lookup_single' :: Resolver -> Host -> Site -> IO Int
-lookup_single' resolver host (Site d p (Weight w)) = do
- response <- dnslookup resolver d host
- case response of
- Left _ -> return 0 -- Not listed
- Right ipv4s ->
- case p of
- -- No pattern given, but we got a hit.
- Nothing -> return w
- 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 w
- else return 0
-
-
--- | Look up the given @host@ on all of the white/blacklists contained
--- in @sites@. Return the total \"score\" for the @host@; that is,
--- the sum of the weights for each site whose pattern the host
--- matches.
---
-lookup_simple :: Host -> [Site] -> IO Int
-lookup_simple host sites = do
- rs <- makeResolvSeed defaultResolvConf
- withResolver rs $ \resolver -> do
- results <- mapM (lookup_single' resolver host) sites
- return $ sum results
+ suffix = pack $ "." ++ (pretty_show rbl)
+ dom = (reverse_labels host) `append` suffix
--- | Look up the given @host@ on all of the white/blacklists contained
--- in @sites@. If the results, multiplied by their weights, add up to
--- (at least) @threshold@, then @True@ is returned; that is, the
--- @host@ is \"listed\". Otherwise, @False@ is returned.
---
-lookup_threshold :: Host -> [Site] -> Int -> IO Bool
-lookup_threshold host sites threshold = do
- score <- lookup_simple host sites
- if score >= threshold
- then return True
- else return False
-
--- | See 'lookup_single_details'. The \"prime\" version here takes an
+-- | See 'lookup_single'. The \"prime\" version here takes an
-- additional @resolver@ argument for performance reasons.
--
-lookup_single_details' :: Resolver
- -> Host
- -> Site
- -> IO (Maybe ListingDetails)
-lookup_single_details' resolver host site@(Site d p (Weight w)) = do
+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
-- | Look up a single...
-lookup_single_details :: Host
- -> Site
- -> IO (Maybe ListingDetails)
-lookup_single_details host site = do
+lookup_single :: Host
+ -> Site
+ -> IO (Maybe ListingDetails)
+lookup_single host site = do
rs <- makeResolvSeed defaultResolvConf
- withResolver rs $ \resolver -> lookup_single_details' resolver host site
+ withResolver rs $ \resolver -> lookup_single' resolver host site
-lookup_details :: Host -> [Site] -> IO [ListingDetails]
-lookup_details host sites = do
+lookup :: Host -> [Site] -> IO [ListingDetails]
+lookup host sites = do
rs <- makeResolvSeed defaultResolvConf
withResolver rs $ \resolver -> do
- results <- mapM (lookup_single_details' resolver host) sites
+ results <- mapM (lookup_single' resolver host) sites
return $ catMaybes results
+
+
--- /dev/null
+module Network.DNS.RBL.Host
+where
+
+import Data.ByteString.Char8 (
+ ByteString,
+ intercalate,
+ pack,
+ split )
+import qualified Network.DNS as DNS ( Domain )
+
+import Network.DNS.RBL.Domain ( UserDomain(..) )
+import Network.DNS.RBL.Pretty ( Pretty(..) )
+
+
+-- | A data type representing a host that we would like to look up on
+-- a blacklist. This can be either an IP address (for normal
+-- blacklists) or a domain name (for name-based blacklists).
+--
+-- Rather than make a distinction, we rely on the fact that we can
+-- parse all-digit \"domain names\". That is, we'll happily accept
+-- e.g. \"127.0.0.1\" as a name, and anything that isn't a valid IP
+-- address will implicitly be treated as a name and not an address.
+--
+newtype Host = Host UserDomain
+
+instance Pretty Host where pretty_show (Host d) = pretty_show d
+
+
+-- | Reverse the labels of this host in preparation for making a
+-- lookup (using the DNS library). We need to reverse the labels
+-- (the stuff between the dots) whether we're looking up a host or a
+-- name. The only tricky part here is that we need to turn an
+-- absolute 'UserDomain' into a relative one.
+--
+-- ==== _Examples_
+--
+-- >>> import Text.Parsec ( parse )
+-- >>> import Network.DNS.RBL.Domain ( user_domain )
+--
+-- >>> let (Right r) = parse user_domain "" "1.2.3.4"
+-- >>> let h = Host r
+-- >>> reverse_labels h
+-- "4.3.2.1"
+--
+-- >>> let (Right r) = parse user_domain "" "www.example.com"
+-- >>> let h = Host r
+-- >>> reverse_labels h
+-- "com.example.www"
+--
+-- Make sure absolute names are made relative:
+--
+-- >>> let (Right r) = parse user_domain "" "www.example.com."
+-- >>> let h = Host r
+-- >>> reverse_labels h
+-- "com.example.www"
+--
+reverse_labels :: Host -> DNS.Domain
+reverse_labels (Host h) = reversed
+ where
+ -- | It's possible that we are given an absolute domain name to
+ -- look up. This is legit; say I want to look up
+ -- \"www.example.com.\" That's fine, but before we make the
+ -- actual query we'll need to make it relative and then append
+ -- the DNSBL's suffix to it.
+ relative_host_string :: String
+ relative_host_string =
+ case h of
+ (UserDomainRelative _) -> pretty_show h
+ (UserDomainAbsolute d) -> pretty_show d
+
+ dot = pack "."
+ labels = split '.' (pack relative_host_string)
+ reversed = intercalate dot (reverse labels)
projects / dead / harbl.git / commitdiff