X-Git-Url: http://gitweb.michael.orlitzky.com/?p=dead%2Fharbl.git;a=blobdiff_plain;f=src%2FNetwork%2FDNS%2FRBL.hs;fp=src%2FNetwork%2FDNS%2FRBL.hs;h=0000000000000000000000000000000000000000;hp=3c32e5d97b990d654b92bf1e5ad40279b529c65e;hb=b55e5db2a68be5d69b970bbe4b5ad447881abd3d;hpb=c4d41b93ec02ff4dc762163441ebefb0324e6f07 diff --git a/src/Network/DNS/RBL.hs b/src/Network/DNS/RBL.hs deleted file mode 100644 index 3c32e5d..0000000 --- a/src/Network/DNS/RBL.hs +++ /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 - -