View on
MetaCPAN
Michael Robinton > URBL-Prepare > URPL::Prepare

Download:
URBL-Prepare-0.09.tar.gz

Annotate this POD

View/Report Bugs
Source  

NAME ^

URPL::Prepare -- prepare hostname for URBL domain lookup

SYNOPSIS ^

  require 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 methods ^

The following three methods are for facilitating URBL lookups.

  SEE:  http://www.uribl.com/about.shtml
  and   http://www.surbl.org/guidelines

APPLICATION EXAMPLES ^

This 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);

AUTHOR ^

Michael Robinton <michael@bizsystems.com>

COPYRIGHT ^

    Copyright 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

syntax highlighting: