dnsrbl (empty) → 0.0.1
raw patch · 7 files changed
+243/−0 lines, 7 filesdep +HUnitdep +basedep +containerssetup-changed
Dependencies added: HUnit, base, containers, hsdns, network
Files
- LICENSE +26/−0
- Network/DNSRBL.hs +142/−0
- README +31/−0
- Setup.lhs +15/−0
- dnsrbl.cabal +16/−0
- prologue.txt +1/−0
- tests/dnsrbltest.hs +12/−0
+ LICENSE view
@@ -0,0 +1,26 @@+Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above copyright+ notice, this list of conditions and the following disclaimer in the+ documentation and/or other materials provided with the distribution.++ * The names of its contributors may not be used to endorse or promote+ products derived from this software without specific prior written+ permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS+IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED+TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A+PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER+OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,+EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,+PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR+PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF+LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING+NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS+SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Network/DNSRBL.hs view
@@ -0,0 +1,142 @@+{- |+ 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)+-- |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"),+ ("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' 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 (filter name rbls) (map (\rbl -> (host++"."++(server rbl) )) (filter name rbls) )++-- 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) )++-- |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)++-- |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) )++-- | 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)++++-- | 'sanquery' 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))) )
+ README view
@@ -0,0 +1,31 @@+Real Time DNS BlackList Lookup+=========================================++:Latest Release: dnsrbl-0.1.tgz++Synopsis+--------+ A parallel real time DNS BlackList lookup. Because no-one likes spammers.+ ++Documentation+-------------++ `Reference Documentation`_+ Haddock-generated reference of all exported functions.++See Also+--------+ The internet :P++Copyleft+--------++ Copyright (c) 2008 Holden Karau <holden@pigscanfly.ca>. All rights+ reserved. This software is released under `<LICENSE>`_.++-----------------------------------------------------------------++`[Homepage] <http://www.holdenkarau.com/>`_++.. _Reference Documentation: docs/index.html
+ Setup.lhs view
@@ -0,0 +1,15 @@+#!/usr/bin/env runhaskell+>import Distribution.Simple+>import Distribution.Simple+>import Distribution.PackageDescription(PackageDescription,dataFiles)+>import Distribution.Simple.LocalBuildInfo(LocalBuildInfo,srcPref)+>import System.Cmd(system)+>import Distribution.Simple.LocalBuildInfo+>import System.IO(FilePath)++>main :: IO ()+>main = defaultMainWithHooks (simpleUserHooks {runTests = runzeTests})++>runzeTests:: Args -> Bool -> PackageDescription -> LocalBuildInfo -> IO ()+>runzeTests a b pd lb = system ( "runhaskell ./tests/dnsrbltest.hs") >> return()+
+ dnsrbl.cabal view
@@ -0,0 +1,16 @@+Name: dnsrbl+Version: 0.0.1+Author: Holden Karau <holden@pigscanfly.ca>+Maintainer: Holden <holden@pigscanfly.ca>+License: BSD3+License-File: LICENSE+Homepage: http://www.pigscanfly.ca/~holden/dnsrbl/+Synopsis: Asynchronous DNS RBL lookup+Description: Asynchronous DNS RBL lookup+Category: Network+Build-Depends: base, network, containers, hsdns, HUnit+Exposed-Modules: Network.DNSRBL+GHC-Options: -Wall -threaded+Data-Files: README, prologue.txt+Build-Type: Simple+extra-source-files: tests/dnsrbltest.hs
+ prologue.txt view
@@ -0,0 +1,1 @@+Anynchronously lookup a given domain/ip on multiple DSNRBLs
+ tests/dnsrbltest.hs view
@@ -0,0 +1,12 @@+import Test.HUnit+import Network.DNSRBL+import List (sort)++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]++main = runTestTT tests