dnsrbl 0.0.1 → 0.0.2
raw patch · 3 files changed
+79/−24 lines, 3 filesPVP: major bump suggested
API removals or changes: PVP suggests a major version bump
API changes (from Hackage documentation)
- Network.DNSRBL: instance Show RBL
Files
- Network/DNSRBL.hs +67/−19
- dnsrbl.cabal +1/−1
- tests/dnsrbltest.hs +11/−4
Network/DNSRBL.hs view
@@ -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
dnsrbl.cabal view
@@ -1,5 +1,5 @@ Name: dnsrbl-Version: 0.0.1+Version: 0.0.2 Author: Holden Karau <holden@pigscanfly.ca> Maintainer: Holden <holden@pigscanfly.ca> License: BSD3
tests/dnsrbltest.hs view
@@ -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