|
NAMEURPL::Prepare -- prepare hostname for URBL domain lookup SYNOPSISrequire URBL::Prepare; my $ubp = new URBL::Prepare; $tlds = $blessed->cachetlds($localfilelistptr); $whitelist = $blessed->cachewhite($localfilelistptr); $domain = $blessed->urbldomain($hostname); $response_code = $proto->loadcache($url,$localfile); ($response,$message) = $proto->loadcache($url,$localfile); $rv = $blessed->urblblack($hostname); $rv = $blessed->urblwhite($hostname); DESCRIPTION
URBL Preparation for lookup methodsThe following three methods are for facilitating URBL lookups. SEE: http://www.uribl.com/about.shtml and http://www.surbl.org/guidelines
APPLICATION EXAMPLESThis example shows how to include URBL::Prepare in another module #!/usr/bin/perl
package = Some::Package
use vars qw(@ISA);
require URBL::Prepare;
@ISA = qw( URBL::Prepare );
sub new {
my $proto = shift;
my $class = ref $proto || $proto || __PACKAGE__;
my $methodptr = {
....
};
bless $methodptr, $class;
}
... package code ...
1;
...end
......................
#!/usr/bin/perl
# my application
#
use Net::DNS::Dig;
use Some::Package;
my $dig = new Net::DNS::Dig;
my $sp = new Some::Package;
#
# initialiaze URBL::Prepare
#
$sp->cachewhite($localwhitefiles);
$sp->cachetlds($localtldfiles);
# set multi.surbl.org bit mask
# 2 = comes from SC
# 4 = comes from WS
# 8 = comes from PH
# 16 = comes from OB (OB is deprecated as of 22 October 2012.)
# 16 = comes from MW (MW active as of 1 May 2013.)
# 32 = comes from AB
# 64 = comes from JP
# test as: surbl-org-permanent-test-point.com.multi.surbl.org
my $mask = 0xDE;
... application ...
... generates ...
... hostname ...
my $domain = $sp->urbldomain($hostname)
my $response = $dig->for($hostname . 'multi.surbl.org')
if $domain; # if not whitelisted
# if an answer is returned
if ($domain && $response->{HEADER}->{ANCOUNT}) {
# get packed ipV4 answer
my $answer = $response->{ANSWER}->[0]->{RDATA}->[0];
if ($mask & unpack("N",$answer)) {
# answer is found in selected surbl list
} else {
# answer not found in selected surbl list
}
}
# domain not found in surbl
...end
This is an example of a script file to keep the whitelist and tldlist current. Run as a cron job daily. #!/usr/bin/perl # # cache refresh cron job # require URBL::Prepare; my $whiteurl = 'http://spamassasin.googlecode.com/svn-history/r6/trunk/share/spamassassin/25_uribl.cf'; my $tld2url = 'http://george.surbl.org/two-level-tlds'; my $tld3url = 'http://george.surbl.org/three-level-tlds'; my $cachedir = './cache'; my $lvl2file = $cachedir .'/level2'; my $lvl3file = $cachedir .'/level3'; my $whtfile = $cachedir .'/white'; mkdir $cachedir unless -d $cachedir; URBL::Prepare->loadcache($whiteurl,$whtfile); URBL::Prepare->loadcache($tld2url,$lvl2file); URBL::Prepare->loadcache($tld3url,$lvl3file); AUTHORMichael Robinton <michael@bizsystems.com> COPYRIGHTCopyright 2013-2014, Michael Robinton <michael@bizsystems.com> This program is free software; you may redistribute it and/or modify it under the same terms as Perl itself. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See also:LWP::Request, Net::DNS::Dig
|