Archive for the 'Perl' Category

Sep 08

Block spam with OriginatingCountry SpamAssassin plugin

Tuesday, September 8th, 2009

Save 2 files below in /etc/mail/spamassassin directory and enable plugin by add line

PLAIN TEXT
CODE:
  1. loadplugin Mail::SpamAssassin::Plugin::OriginatingCountry OriginatingCountry.pm

in file /etc/mail/spamassassin/init.pre

Check and adjust score with your system :)

File OriginatingCountry.pm

PLAIN TEXT
CODE:
  1. package Mail::SpamAssassin::Plugin::OriginatingCountry;
  2.  
  3. use Mail::SpamAssassin::Plugin;
  4. use Mail::SpamAssassin::Constants qw(:ip);
  5. use strict;
  6. use warnings;
  7. use bytes;
  8.  
  9. use vars qw(@ISA);
  10. @ISA = qw(Mail::SpamAssassin::Plugin);
  11.  
  12. sub dbg { Mail::SpamAssassin::Plugin::dbg ("xip: @_"); }
  13.  
  14. sub new {
  15.   my $class = shift;
  16.   my $mailsaobject = shift;
  17.  
  18.   $class = ref($class) || $class;
  19.   my $self = $class->SUPER::new($mailsaobject);
  20.   bless ($self, $class);
  21.  
  22.   $self->register_eval_rule ("check_x_ip_header");
  23.   $self->register_eval_rule ("check_yahoo_ip_header");
  24.   $self->register_eval_rule ("check_authen_ip_header");
  25.   $self->register_eval_rule ("check_any_ip_header");
  26.  
  27.   return $self;
  28. }
  29.  
  30.  
  31. sub check_x_ip_header {
  32.   my ($self, $permsgstatus, $regex) = @_;
  33.   my $reg;
  34.   eval {
  35.     require IP::Country::Fast;
  36.     $reg = IP::Country::Fast->new();
  37.   };
  38.   if ($@) {
  39.     dbg("failed to load 'IP::Country::Fast', skipping ($@)");
  40.     return 1;
  41.   }
  42.   my $ip = ($permsgstatus->get("X-Originating-IP"));
  43.   $ip =~ s/[\[\]]//g;
  44.   my $IP_ADDRESS = IP_ADDRESS;
  45.   if ($ip =~ /$IP_ADDRESS/) {
  46.   dbg("Found x-ip $ip");
  47.   my $country = '';
  48.   my $cc = $reg->inet_atocc($ip) || "XX";
  49.   $country = $cc;
  50.   chomp $country;
  51.   dbg("X-Originating-IP: $country");
  52.     my $re;
  53.     if (defined $regex) {
  54.         $re = eval { qr/$regex/; };
  55.         if ($@) {
  56.             warn("invalid regex: $@");
  57.             return 0;
  58.         }
  59.     }
  60.     if (defined $re) {
  61.        if ($country =~ $re) {
  62.            dbg("Found hotmail country and matches regex: $country");
  63.            return 1;
  64.        }
  65.      }
  66.    }
  67.    return 0;
  68. }
  69.  
  70. sub check_yahoo_ip_header {
  71.   my ($self, $permsgstatus, $regex) = @_;
  72.   my $reg;
  73.   eval {
  74.     require IP::Country::Fast;
  75.     $reg = IP::Country::Fast->new();
  76.   };
  77.   if ($@) {
  78.     dbg("failed to load 'IP::Country::Fast', skipping ($@)");
  79.     return 1;
  80.   }
  81.   my $ip = '';
  82.   if ($permsgstatus->get("Received") =~ /\s?from\s+(\S+)\s+by\s+web[a-z0-9\.]+\.yahoo\.[a-z0-9\.]+\s+via\s+HTTP\;/) {
  83.     $ip = $1;
  84.     $ip =~ s/[\[\]]//g;
  85.    dbg("Found yahoo-ip: $ip");
  86.    my $country = '';
  87.    my $cc = $reg->inet_atocc($ip) || "XX";
  88.    $country = $cc;
  89.    chomp $country;
  90.    dbg("Yahoo-IP: $country");
  91.      my $re;
  92.      if (defined $regex) {
  93.          $re = eval { qr/$regex/; };
  94.          if ($@) {
  95.              warn("invalid regex: $@");
  96.              return 0;
  97.          }   
  98.      }
  99.      if (defined $re) {
  100.          if ($country =~ $re) {
  101.              dbg("Found yahoo country and matches regex: $country");
  102.              return 1;
  103.          }
  104.      }   
  105.   } 
  106.   return 0;
  107. }
  108.  
  109. sub check_authen_ip_header {
  110.   my ($self, $permsgstatus, $regex) = @_;
  111.   my $reg;
  112.   eval {
  113.     require IP::Country::Fast;
  114.     $reg = IP::Country::Fast->new();
  115.   };
  116.   if ($@) {
  117.     dbg("failed to load 'IP::Country::Fast', skipping ($@)");
  118.     return 1;
  119.   }
  120.   my $ip = '';
  121.   if ($permsgstatus->get("Received") =~ /\s?from\s+\w+\s+(\S+)/) {
  122.     $ip = $1;
  123.     $ip =~ s/[\[\]]//g;
  124.  
  125.    dbg("Found authen-ip: $ip");
  126.  
  127.    my $country = '';
  128.    my $cc = $reg->inet_atocc($ip) || "XX";
  129.    $country = $cc;
  130.    chomp $country;
  131.    dbg("Authen-IP: $country");
  132.    my $re;
  133.      if (defined $regex) {
  134.          $re = eval { qr/$regex/; };
  135.          if ($@) {
  136.              warn("invalid regex: $@");
  137.              return 0;
  138.          }   
  139.      }
  140.      if (defined $re) {
  141.           if ($country =~ $re) {
  142.               dbg("Found authen country and matches regex: $country");
  143.               return 1;
  144.           }
  145.      }   
  146.   } 
  147.   return 0;
  148. }
  149.  
  150. sub check_any_ip_header {
  151.   my ($self, $permsgstatus, $regex) = @_;
  152.   return ( $self->check_x_ip_header($permsgstatus,$regex) ||
  153.               $self->check_yahoo_ip_header($permsgstatus,$regex) ||
  154.               $self->check_authen_ip_header($permsgstatus,$regex)
  155.             );
  156. }
  157.  
  158. 1;

File originate_ip.cf

PLAIN TEXT
CODE:
  1. ifplugin Mail::SpamAssassin::Plugin::OriginatingCountry
  2.  
  3. header   X_ORIG_IP_CN  eval:check_any_ip_header('CN')
  4. describe X_ORIG_IP_CN  Message was sending originate from China
  5. score    X_ORIG_IP_CN  5.00
  6.  
  7. header   X_ORIG_IP_NG  eval:check_any_ip_header('NG')
  8. describe X_ORIG_IP_NG  Message was sending originate from Nigeria
  9. score    X_ORIG_IP_NG  1.00
  10.  
  11. header   X_ORIG_IP_SN  eval:check_any_ip_header('SN')
  12. describe X_ORIG_IP_SN  Message was sending originate from Senegal
  13. score    X_ORIG_IP_SN  1.00
  14.  
  15. header   X_ORIG_IP_BN  eval:check_any_ip_header('BN')
  16. describe X_ORIG_IP_BN  Message was sending originate from Benin
  17. score    X_ORIG_IP_BN  1.00
  18.  
  19. header   X_ORIG_IP_GH  eval:check_any_ip_header('GH')
  20. describe X_ORIG_IP_GH  Message was sending originate from Ghana
  21. score    X_ORIG_IP_GH  1.00
  22.  
  23. header   X_ORIG_IP_CI  eval:check_any_ip_header('CI')
  24. describe X_ORIG_IP_CI  Message was sending originate from Ivoiry Coast
  25. score    X_ORIG_IP_CI  1.00
  26.  
  27. header   X_ORIG_IP_ZA  eval:check_any_ip_header('ZA')
  28. describe X_ORIG_IP_ZA  Message was sending originate from South Africa
  29. score    X_ORIG_IP_ZA  1.00
  30.  
  31. endif

Posted in Internet, Perl, Programming, Spam | 2 Comments »

Feb 07

Online tool to help programmer deal with messy php code

Wednesday, February 7th, 2007

Today, I try to search program to make my php source code for better read and easy to understand and I found good one that I would like to suggest for all php programmer.

Online source code beautifier

This tool source code beautifier (source code formatter) also work with Java, C++, C, Perl, JavaScript, CSS code.

Posted in PHP, Perl | No Comments »

Feb 06

Fix get_insert_id function of Net::MySQL

Tuesday, February 6th, 2007

After I try to find Pure Perl of MySQL network protocol interface, I've found Net::MySQL on CPAN but there have some problem if you use get_insert_id and AUTO_INCREMENT value of table more than 255 the function will always return 254.

Current version of Net::MySQL 0.09 released on 01 Apr 2006

(more...)

Posted in Perl, Programming | No Comments »