Bug 6599: Add Geo::IP support to RelayCountries

git-svn-id: https://svn.apache.org/repos/asf/spamassassin/trunk@1308059 13f79535-47bb-0310-9956-ffa450edef68

INSTALL

@@ -363,11 +363,14 @@ version is too low for them to be used.
     perl interpreter.  NetAddr::IP version 4.007 or later fixes this.
 
 
-  - IP::Country::Fast (from CPAN)
+  - Geo::IP (from CPAN)
 
     Used by the RelayCountry plugin (not enabled by default) to determine
     the domain country codes of each relay in the path of an email.
 
+    IP::Country::Fast is used as alternative if Geo::IP is not installed.
+    This is not recommended as it's obsolete.
+
 
   - Net::Ident (from CPAN)
 

META.yml

@@ -49,7 +49,7 @@ recommends:
     IO::Socket::INET6:    0
     IO::Socket::SSL:      0
     IO::Zlib:             1.04
-    IP::Country::Fast:    0
+    Geo::IP:              0
     LWP::UserAgent:       0
     Mail::DKIM:           0.37
     Mail::SPF:            0

Makefile.PL

@@ -343,7 +343,7 @@ foreach my $file (@FILES_THAT_MUST_EXIST) {
     'DB_File' =>                   0,
     'Net::SMTP' =>                 0,
     'Mail::SPF' =>                 0,
-    'IP::Country::Fast' =>         0,
+    'Geo::IP' =>                   0,
     'Razor2::Client::Agent' =>     2.61,
     'Net::Ident' =>                0,
     'IO::Socket::INET6' =>         0,

lib/Mail/SpamAssassin/Plugin/RelayCountry.pm

@@ -32,14 +32,16 @@ the C<_RELAYCOUNTRY_> header markup.
 
 =head1 REQUIREMENT
 
-This plugin requires the IP::Country module from CPAN.
+This plugin requires the Geo::IP module from CPAN. For backwards
+compatibility IP::Country::Fast is used if Geo::IP is not installed.
 
 =cut
 
 package Mail::SpamAssassin::Plugin::RelayCountry;
 
 use Mail::SpamAssassin::Plugin;
 use Mail::SpamAssassin::Logger;
+use Mail::SpamAssassin::Constants qw(:ip);
 use strict;
 use warnings;
 use bytes;
@@ -48,6 +50,52 @@ use re 'taint';
 use vars qw(@ISA);
 @ISA = qw(Mail::SpamAssassin::Plugin);
 
+my ($db, $dbv6);
+my $ip_to_cc; # will hold a sub() for the lookup
+my $db_info;  # will hold a sub() for database info
+
+# Try to load Geo::IP first
+eval {
+  require Geo::IP;
+  $db = Geo::IP->open_type(Geo::IP->GEOIP_COUNTRY_EDITION, Geo::IP->GEOIP_STANDARD);
+  die "GeoIP.dat not found" unless $db;
+  # IPv6 requires version Geo::IP 1.39+ with GeoIP C API 1.4.7+
+  if (Geo::IP->VERSION >= 1.39 && Geo::IP->api eq 'CAPI') {
+    $dbv6 = Geo::IP->open_type(Geo::IP->GEOIP_COUNTRY_EDITION_V6, Geo::IP->GEOIP_STANDARD);
+    if (!$dbv6) {
+      dbg("metadata: RelayCountry: IPv6 support not enabled, GeoIPv6.dat not found");
+    }
+  } else {
+    dbg("metadata: RelayCountry: IPv6 support not enabled, versions Geo::IP 1.39, GeoIP C API 1.4.7 required");
+  }
+  $ip_to_cc = sub {
+    if ($dbv6 && $_[0] =~ /:/) {
+      return $dbv6->country_code_by_addr_v6($_[0]) || "XX";
+    } else {
+      return $db->country_code_by_addr($_[0]) || "XX";
+    }
+  };
+  $db_info = sub { return "Geo::IP ".$db->database_info; };
+  1;
+} or do {
+  my $eval_stat = $@ ne '' ? $@ : "errno=$!";  chomp $eval_stat;
+  dbg("metadata: RelayCountry: failed to load 'Geo::IP', skipping: $eval_stat");
+  # Try IP::Country::Fast as backup
+  eval {
+    require IP::Country::Fast;
+    $db = IP::Country::Fast->new();
+    $ip_to_cc = sub {
+      return $db->inet_atocc($_[0]) || "XX";
+    };
+    $db_info = sub { return "IP::Country::Fast ".localtime($db->db_time()); };
+    1;
+  } or do {
+    my $eval_stat = $@ ne '' ? $@ : "errno=$!";  chomp $eval_stat;
+    dbg("metadata: RelayCountry: failed to load 'IP::Country::Fast', skipping: $eval_stat");
+    return 1;
+  };
+};
+
 # constructor: register the eval rule
 sub new {
   my $class = shift;
@@ -63,24 +111,17 @@ sub new {
 sub extract_metadata {
   my ($self, $opts) = @_;
 
-  my $reg;
-
-  eval {
-    require IP::Country::Fast;
-    $reg = IP::Country::Fast->new();
-    1;
-  } or do {
-    my $eval_stat = $@ ne '' ? $@ : "errno=$!";  chomp $eval_stat;
-    dbg("metadata: failed to load 'IP::Country::Fast', skipping: $eval_stat");
-    return 1;
-  };
+  return 1 unless $db;
 
+  dbg("metadata: RelayCountry: Using database: ".$db_info->());
   my $msg = $opts->{msg};
 
   my $countries = '';
+  my $IP_PRIVATE = IP_PRIVATE;
   foreach my $relay (@{$msg->{metadata}->{relays_untrusted}}) {
     my $ip = $relay->{ip};
-    my $cc = $reg->inet_atocc($ip) || "XX";
+    # Private IPs will always be returned as '**'
+    my $cc = $ip =~ /^$IP_PRIVATE$/o ? '**' : $ip_to_cc->($ip);
     $countries .= $cc." ";
   }
 
@@ -93,6 +134,9 @@ sub extract_metadata {
 
 sub parsed_metadata {
   my ($self, $opts) = @_;
+
+  return 1 unless $db;
+
   $opts->{permsgstatus}->set_tag ("RELAYCOUNTRY",
           $opts->{permsgstatus}->get_message->get_metadata('X-Relay-Countries'));
   return 1;

lib/Mail/SpamAssassin/Util/DependencyInfo.pm

@@ -138,8 +138,7 @@ $have_sha ? {
   address forgery and make it easier to identify spams.',
 },
 {
-  module => 'IP::Country::Fast',
-  alt_name => 'IP::Country',
+  module => 'Geo::IP',
   version => 0,
   desc => 'Used by the RelayCountry plugin (not enabled by default) to determine
   the domain country codes of each relay in the path of an email.',

rules/init.pre

@@ -17,7 +17,7 @@
 # RelayCountry - add metadata for Bayes learning, marking the countries
 # a message was relayed through
 #
-# Note: This requires the IP::Country::Fast Perl module
+# Note: This requires the Geo::IP Perl module
 #
 # loadplugin Mail::SpamAssassin::Plugin::RelayCountry