dnsrbl-0.0.2: Network/DNSRBL.hs
{- |
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))) )