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)
data RBL = RBL { namexp :: [(String,String)],
server :: String,
ip :: Bool,
name :: Bool} deriving Show
rbls :: [RBL]
rbls = (RBL [("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"
True
False):(RBL [("INTERSERVE","127.0.0.2")]
"rbl.interserver.net"
True
False):[]
toRR :: HostAddress -> String
toRR ha = shows b4 . ('.':) .
shows b3 . ('.':) .
shows b2 . ('.':) .
shows b1 $ ""
where
(b1,b2,b3,b4) = readWord32 ha
toPR :: HostAddress -> String
toPR ha = shows b1 . ('.':).
shows b2 . ('.':).
shows b3 . ('.':).
shows b4 $ ""
where
(b1,b2,b3,b4) = readWord32 ha
myqueryA :: Resolver -> HostName -> IO [HostAddress]
myqueryA resolver host = queryA resolver host >>=(\a -> case a of
(Just b) -> return b
_ -> return [] )
rstrs :: String -> [HostAddress] -> [(RBL,String)]
rstrs host ips = (namerstrs host )++(concatMap iprstrs ips)
namerstrs :: HostName -> [(RBL,String)]
namerstrs host = zip (filter name rbls) (map (\rbl -> (host++"."++(server rbl) )) (filter name rbls) )
iprstrs :: HostAddress -> [(RBL,String)]
iprstrs host = zip (filter ip rbls) (map (\rbl -> ((toRR host)++"."++(server rbl) )) (filter ip rbls) )
ismatch :: String -> HostAddress -> Bool
ismatch str haddr = ((toPR haddr) == str)
rrtsb :: RBL -> [HostAddress] -> [(String,Bool)]
rrtsb rbl res = (map (\x -> ((fst x), foldr (||) False (map (ismatch (snd x)) res))) (namexp rbl) )
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 :: String -> IO [(String,Bool)]
dorbls host = initResolver [NoErrPrint, NoServerWarn] $ \resolver -> do
hostip <- (myqueryA resolver host )
results <- (dorblf host hostip resolver)
return results
dorblf :: String -> [HostAddress] -> Resolver -> IO [(String,Bool)]
dorblf host ips resolver = do
rrChannel <- newChan :: IO (Chan [(String,Bool)])
mapM_ (\h -> forkIO (dowork resolver rrChannel h)) queries
s <- replicateM (length queries) (readChan rrChannel )
return (concat s)
where
queries = (rstrs host ips)
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 :: 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))) )