{- | Module : Network.DNSRBL Copyright : (c) 2008 Holden Karau License : LGPL Maintainer : holden@pigscanfly.ca Stability : provisional Portability : portable Anynchronously lookup a host on multiple DSNRBLs. -} module Network.DNSRBL(dorbls,dorblf,asanequery,sanequery) where import ADNS (HostName,HostAddress,initResolver,Resolver,InitFlag(..),queryA) import ADNS.Endian (readWord32) import Control.Concurrent.Chan ( Chan, newChan, writeChan, readChan ) import Control.Monad ( replicateM ) import Control.Concurrent ( forkIO ) import Data.List (sort,group) import Data.Bits import Data.Word import qualified Data.Map as M -- |A 'RBL' data type contains the information about a real time blacklist. -- The names are the names of the different black lists -- and are paired with the expected result -- The server is the server which does the resolution -- ip is true if the RBL support lookups on IP addresses (i.e. 127.0.0.1) -- name is true if the RBL lookups names (i.e. foo.com) data RBL = RBL { namexp :: [HostAddress] -> [(String,Bool)], server :: String } -- |'irbls' is the list of real time black lists used irbls :: [RBL] irbls = [(RBL (parsefromlist [("SBL","127.0.0.2"), ("CBL","127.0.0.4"), ("NJBL","127.0.0.5"), ("PBLI","127.0.0.10"), ("PBLS","127.0.0.11")] ) "zen.spamhaus.org" ), (RBL (parsefromlist [("INTERSERVE","127.0.0.2")] ) "rbl.interserver.net" ), (RBL (parsefromlist [("KARMASPHEREBAD","127.0.0.2")] ) "karmasphere.email-sender.dnsbl.karmasphere.com"), (RBL (parsefromlist [("AHBLOR","127.0.0.2"), ("AHBLOP","127.0.0.3"), ("AHBSPAM","127.0.0.4"), ("AHBPSSLB","127.0.0.5"), ("AHBFSPAM","127.0.0.6"), ("AHBSSUP","127.0.0.7"), ("AHBSSUPI","127.0.0.8"), ("AHBEUNM","127.0.0.9"), ("AHBSOS","127.0.0.10"), ("AHBRFCFAIL","127.0.0.11"), ("AHB5EFAIL","127.0.0.12"), ("AHBORFCFAIL","127.0.0.13"), ("AHBCDDOS","127.0.0.14"), ("AHBCRELAY","127.0.0.15"), ("AHBCSC","127.0.0.16"), ("AHBWORM","127.0.0.17"), ("AHBVIRUS","127.0.0.18"), ("AHBOP2","127.0.0.19"), ("AHBBSPAM","127.0.0.20"), ("AHBMISC","127.0.0.127")] ) "dnsbl.ahbl.org")] nrbls :: [RBL] nrbls = [(RBL (parsefromlist [("AHRHSBL","127.0.0.2")] ) "rhsbl.ahbl.org"), (RBL (parsefrommask [("SURBLSPAMCOP",2), ("SURBLBS",4), ("SURBLPH",8), ("SURBLOB",16), ("SURBLAB",32), ("SURBLJP",64)] ) "multi.surbl.org"), (RBL (parsefromlist [("EXDSNBL2","127.0.0.2"), ("EXDNSBL3","127.0.0.3")]) "ex.dnsbl.org")] -- | 'parsefrommask' takes a list of Strings and masks --and returns a parsing function parsefrommask :: [(String,Word)] -> [HostAddress] -> [(String,Bool)] parsefrommask il has = (map (\x -> (fst x,(foldr (||) False (map (matchmask (snd x)) has)))) il) -- | 'matchmask' takes a mask and a host address and returns true if it -- matches matchmask :: Word -> HostAddress -> Bool matchmask mask ha = ((.&.) b4 mask) == mask where (b1,b2,b3,b4) = readWord32 ha -- | 'parsefromlist' takse a list of Strings and Strings --and makes a parsing function parsefromlist :: [(String,String)] -> [HostAddress] -> [(String,Bool)] parsefromlist il has = (map (\x -> (fst x,(foldr (||) False (map (== (snd x)) hass)))) il) where hass = map toPR has -- | 'toRR' convers a HostAddress to a string in reverse -- (i.e. 127.0.0.1 printed as 1.0.0.127) toRR :: HostAddress -> String toRR ha = shows b4 . ('.':) . shows b3 . ('.':) . shows b2 . ('.':) . shows b1 $ "" where (b1,b2,b3,b4) = readWord32 ha -- | 'toPR' converts a HostAddress to a string toPR :: HostAddress -> String toPR ha = shows b1 . ('.':). shows b2 . ('.':). shows b3 . ('.':). shows b4 $ "" where (b1,b2,b3,b4) = readWord32 ha -- |Wrap queryA and return the result -- or in the event of an error an empty list myqueryA :: Resolver -> HostName -> IO [HostAddress] myqueryA resolver host = queryA resolver host >>=(\a -> case a of (Just b) -> return b _ -> return [] ) -- |Get the lookup strings host name in all the RBLs -- (resolving its IP address for the IP based RBLS) rstrs :: String -> [HostAddress] -> [(RBL,String)] rstrs host ips = (namerstrs host )++(concatMap iprstrs ips) -- |Get the lookup strings for name based RBLs namerstrs :: HostName -> [(RBL,String)] namerstrs host = zip nrbls (map (\rbl -> (host++"."++(server rbl) )) nrbls ) -- Get the lookup string for the ip based RBLs iprstrs :: HostAddress -> [(RBL,String)] iprstrs host = zip irbls (map (\rbl -> ((toRR host)++"."++(server rbl) )) irbls ) -- |Is match compares a HostAddress and a String and sees if they are a match ismatch :: ([HostAddress]->[(String,Bool)]) -> [HostAddress] -> [(String, Bool)] ismatch func haddr = func haddr -- |Takes and RBL and a HostAddress list and return a list of strings -- (where the string is the name of the RBL) & the bool is where it is listed or not rrtsb :: RBL -> [HostAddress] -> [(String,Bool)] rrtsb rbl res = ismatch (namexp rbl) res -- | dowork does the semi-heavy lifting dowork :: Resolver -> Chan [(String,Bool)] -> (RBL, HostName) -> IO () dowork resolver channel query=do a <- (myqueryA resolver (snd query) ) writeChan channel (rrtsb (fst query) a) -- |'dorbls' is a friendly wrapper around -- dorblf which only requires a hostname dorbls :: String -> IO [(String,Bool)] dorbls host = initResolver [NoErrPrint, NoServerWarn] $ \resolver -> do hostip <- (myqueryA resolver host ) results <- (dorblf host hostip resolver) return results -- |'dorblf' returns a list of (String,Bool) where -- the string is the RBL name and Bool is if it was found or not -- Note: There may be multiple instances of the same string -- with different Bool values since one hostname may resolve to multiple IPs -- some of which may match and some of which may not match dorblf :: String -> [HostAddress] -> Resolver -> IO [(String,Bool)] dorblf host ips resolver = do rrChannel <- newChan :: IO (Chan [(String,Bool)]) --results <- getChanContents rrChannel mapM_ (\h -> forkIO (dowork resolver rrChannel h)) queries --wait (length queries) results 0 --return results s <- replicateM (length queries) (readChan rrChannel ) return (concat s) where queries = (rstrs host ips) -- | 'sanequery' is a Wrapper of "dorbls" which has only one instance -- of each RBL and -- if any of the elements were found in the RBL (name, any of the IPs) -- it is true, otherwise it is false sanequery :: String -> IO [(String,Bool)] sanequery host = do results <- dorbls host return (map (\x-> ((fst (head x)),(foldl (\y z -> y || (snd z)) False x) ) ) (group (sort (results))) ) -- | 'asanequery' is a wrapper of dorblf which has only one instance of RBL and -- if any of the elements were found in the RBL (name, any of the IPs) -- if it is true otherwise it is false. asanequery :: String -> [HostAddress] -> Resolver -> IO [(String,Bool)] asanequery host ipl resolver = do results <- dorblf host ipl resolver return (map (\x-> ((fst (head x)),(foldl (\y z -> y || (snd z)) False x) ) ) (group (sort (results))) )