diff --git a/Network/DNSRBL.hs b/Network/DNSRBL.hs --- a/Network/DNSRBL.hs +++ b/Network/DNSRBL.hs @@ -17,30 +17,78 @@ 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 :: [(String,String)], - server :: String, - ip :: Bool, - name :: Bool} deriving Show --- |'rbls' is the list of real time black lists used -rbls :: [RBL] -rbls = (RBL [("SBL","127.0.0.2"), +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")] + ("PBLS","127.0.0.11")] ) "zen.spamhaus.org" - True - False):(RBL [("INTERSERVE","127.0.0.2")] + ), + (RBL (parsefromlist [("INTERSERVE","127.0.0.2")] ) "rbl.interserver.net" - True - False):[] - + ), + (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 @@ -75,20 +123,20 @@ -- |Get the lookup strings for name based RBLs namerstrs :: HostName -> [(RBL,String)] -namerstrs host = zip (filter name rbls) (map (\rbl -> (host++"."++(server rbl) )) (filter name rbls) ) +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 (filter ip rbls) (map (\rbl -> ((toRR host)++"."++(server rbl) )) (filter ip rbls) ) +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 :: String -> HostAddress -> Bool -ismatch str haddr = ((toPR haddr) == str) +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 = (map (\x -> ((fst x), foldr (||) False (map (ismatch (snd x)) res))) (namexp rbl) ) +rrtsb rbl res = ismatch (namexp rbl) res -- | dowork does the semi-heavy lifting dowork :: Resolver -> Chan [(String,Bool)] -> (RBL, HostName) -> IO () @@ -122,7 +170,7 @@ --- | 'sanquery' is a Wrapper of "dorbls" which has only one instance +-- | '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 diff --git a/dnsrbl.cabal b/dnsrbl.cabal --- a/dnsrbl.cabal +++ b/dnsrbl.cabal @@ -1,5 +1,5 @@ Name: dnsrbl -Version: 0.0.1 +Version: 0.0.2 Author: Holden Karau Maintainer: Holden License: BSD3 diff --git a/tests/dnsrbltest.hs b/tests/dnsrbltest.hs --- a/tests/dnsrbltest.hs +++ b/tests/dnsrbltest.hs @@ -4,9 +4,16 @@ test1 = TestCase(do x <- (sanequery "pigscanfly.ca") - (assertEqual "pigscanflycashouldbeclean" - [("CBL",True),("INTERSERVE",False),("NJBL",False),("PBLI",False),("PBLS",False),("SBL",False)] - (sort x) )) -tests = TestList [TestLabel "firsttest" test1] + (assertEqual "pigscanflycashouldbemostlyclean" [("AHB5EFAIL",False),("AHBBSPAM",False),("AHBCDDOS",False),("AHBCRELAY",False),("AHBCSC",False),("AHBEUNM",False),("AHBFSPAM",False),("AHBLOP",False),("AHBLOR",False),("AHBMISC",False),("AHBOP2",False),("AHBORFCFAIL",False),("AHBPSSLB",False),("AHBRFCFAIL",False),("AHBSOS",False),("AHBSPAM",False),("AHBSSUP",False),("AHBSSUPI",False),("AHBVIRUS",False),("AHBWORM",False),("AHRHSBL",False),("CBL",True),("EXDNSBL3",False),("EXDSNBL2",False),("INTERSERVE",False),("KARMASPHEREBAD",True),("NJBL",False),("PBLI",False),("PBLS",False),("SBL",False),("SURBLAB",False),("SURBLBS",False),("SURBLJP",False),("SURBLOB",False),("SURBLPH",False),("SURBLSPAMCOP",False)] + (sort x) )) +surblt = TestCase(do + x <- (sanequery "test.surbl.org") + (assertEqual "test.surbl.org is not classy saue" + [("AHRHSBL",False),("EXDNSBL3",False),("EXDSNBL2",False),("SURBLAB",True),("SURBLBS",True),("SURBLJP",True),("SURBLOB",True),("SURBLPH",True),("SURBLSPAMCOP",True)] + (sort x) )) + + + +tests = TestList [TestLabel "firsttest" test1,TestLabel "surbltest" surblt] main = runTestTT tests