=head1 NAME Mail::SpamAssassin::Plugin::iXhash - compute fuzzy checksums from mail bodies and compare to known spam ones via DNS =head1 SYNOPSIS loadplugin Mail::SpamAssassin::Plugin::iXhash /path/to/iXhash.pm # Timeout in seconds - default is 10 seconds ixhash_timeout 10 # Should we add the hashes to the messages' metadata for later re-use # Default is not to cache hashes (i.e. re-compute them for every check) use_ixhash_cache 0 # wether to only use perl (ixhash_pureperl = 1) or the system's 'tr' and 'md5sum' # Default is to use Perl only ixhash_pureperl 1 # If you should have 'tr' and/or 'md5sum' in some weird place (e.g on a Windows server) # or you want to specify which version to use you can specifiy the exact paths here # Default is to have SpamAssassin find the executables ixhash_tr_path "/usr/bin/tr" ixhash_md5sum_path "/usr/bin/md5sum" # The actual rule body IXHASH eval:ixhashtest('ix.dnsbl.manitu.net') describe IXHASH This mail has been classified as spam @ iX Magazine, Germany tflags IXHASH net score IXHASH 1.5 =head1 DESCRIPTION iXhash.pm is a plugin for SpamAssassin 3.0.0 and up. It takes the body of a mail, strips parts from it and then computes a hash value from the rest. These values will then be looked up via DNS to see if the hashes have already been categorized as spam by others. This plugin is based on parts of the procmail-based project 'NiX Spam', developed by Bert Ungerer.(un@ix.de) For more information see http://www.heise.de/ix/nixspam/. The procmail code producing the hashes only can be found here: ftp://ftp.ix.de/pub/ix/ix_listings/2004/05/checksums To see which DNS zones are currently available see http://www.ixhash.net =cut package Mail::SpamAssassin::Plugin::iXhash; use strict; use warnings; use Mail::SpamAssassin::Plugin; use Mail::SpamAssassin::Logger; use Mail::SpamAssassin::Timeout; use Mail::SpamAssassin::Util; use Digest::MD5 qw(md5_hex); use Net::DNS; our @ISA = qw(Mail::SpamAssassin::Plugin); our $VERSION = "1.5.5"; sub new { my ($class, $mailsa) = @_; my $self = $class->SUPER::new($mailsa); bless $self, $class; if ($mailsa->{local_tests_only}) { dbg("IXHASH: Local tests only, disabling iXhash plugin"); $self->{iXhash_available} = 0; } else { dbg("IXHASH: Using iXhash plugin $VERSION"); $self->{iXhash_available} = 1; } $self->set_config($mailsa->{conf}); $self->register_eval_rule("ixhashtest"); return $self; } sub set_config { my ($self, $conf) = @_; my @settings = ( { setting => 'ixhash_timeout', default => 10, type => $Mail::SpamAssassin::Conf::CONF_TYPE_NUMERIC }, { setting => 'use_ixhash_cache', default => 0, type => $Mail::SpamAssassin::Conf::CONF_TYPE_NUMERIC }, { setting => 'ixhash_pureperl', default => 1, type => $Mail::SpamAssassin::Conf::CONF_TYPE_NUMERIC }, { setting => 'ixhash_tr_path', type => $Mail::SpamAssassin::Conf::CONF_TYPE_STRING }, { setting => 'ixhash_md5sum_path', type => $Mail::SpamAssassin::Conf::CONF_TYPE_STRING } ); $conf->{parser}->register_commands(\@settings); } sub ixhashtest { my ($self, $msg_status, @dnszone) = @_; my $dnszone = join('', grep { defined && !ref($_) } @dnszone); $dnszone =~ s/[^a-zA-Z0-9.-]//g; $dnszone =~ s/\s+//g; dbg("IXHASH: ixhashtest() called with DNS zone '$dnszone'"); my $resolver = Net::DNS::Resolver->new; my $body = $msg_status->{msg}->get_pristine_body(); my @hash_methods = (\&compute1sthash, \&compute2ndhash, \&compute3rdhash); my $hash_used = 0; foreach my $i (0..$#hash_methods) { my $compute_hash = $hash_methods[$i]; my $digest = $compute_hash->($body); if (!$digest) { dbg("IXHASH: Hash method #" . ($i + 1) . " not computed - requirements not met"); next; } dbg("IXHASH: Computed digest (Method #" . ($i + 1) . "): $digest"); $hash_used++; my $result = query_dns_for_hash($digest, $dnszone, $resolver); if ($result) { dbg("IXHASH: Hash matched in DNSBL ($digest) - Method #" . ($i + 1) . ")"); return 1; } } if ($hash_used == 0) { dbg("IXHASH: ERROR: No hashes were computed!"); } dbg("IXHASH: No hash match found, returning 0"); return 0; } sub get_cached_or_compute_hash { my ($msg_status, $body, $method_number, $compute_sub) = @_; my $key = "X-iXhash-hash-$method_number"; if ($msg_status->{main}->{conf}->{use_ixhash_cache} && $msg_status->{msg}->get_metadata($key)) { return $msg_status->{msg}->get_metadata($key); } my $digest = $compute_sub->($body); $msg_status->{msg}->put_metadata($key, $digest) if $msg_status->{main}->{conf}->{use_ixhash_cache}; return $digest; } sub query_dns_for_hash { my ($digest, $dnszone, $resolver) = @_; return 0 unless defined $digest && defined $dnszone; # Strip anything that is not a valid MD5 hash or a proper domain $digest =~ s/[^a-fA-F0-9]//g; # Keep only hex characters $dnszone =~ s/[^a-zA-Z0-9.-]//g; # Keep only valid domain characters $dnszone =~ s/\s+//g; # Remove spaces # Ensure we are ONLY querying the hash if (length($digest) != 32) { dbg("IXHASH: ERROR: Digest '$digest' is not a valid 32-character MD5 hash"); return 0; } my $query = "$digest.$dnszone"; dbg("IXHASH: Querying DNS for $query"); my $answer = $resolver->search($query, "A", "IN"); if (!$answer) { dbg("IXHASH: DNS query failed or returned no results for $query"); return 0; } foreach my $rr ($answer->answer) { return 1 if $rr->type eq "A" && $rr->address =~ /^127\.\d{1,3}\.\d{1,3}\.\d{1,3}/; } return 0; } sub compute1sthash { my ($body) = @_; $body =~ s/\s{100,}/ /g; $body =~ s/\s+/ /g; $body =~ s/\P{Graph}+//g; return md5_hex($body); } sub compute2ndhash { my ($body) = @_; # Check if the email body contains at least 3 of the special characters if ($body =~ /((([<>\(\)\|@\*'!?,])|(:\/)).*?){3,}/m) { my $body_copy = $body; $body_copy =~ s/[[:cntrl:][:alnum:]%&#;=]+//g; $body_copy =~ tr/_/./; $body_copy =~ s/([[:print:]]{100})(?:\1+)/$1/g; $body_copy =~ s/([[:print:]])(?:\1+)/$1/g; my $digest = md5_hex($body_copy); # Prevent duplicate hashing with Method #1 if ($digest eq compute1sthash($body)) { dbg("IXHASH: Skipping Hash #2 - Duplicate of Method #1"); return undef; } dbg("IXHASH: Computed Hash #2: $digest"); return $digest; } dbg("IXHASH: Hash method #2 not computed - requirements not met"); return undef; } sub compute3rdhash { my ($body) = @_; # Ensure at least 8 non-space characters exist unless ($body =~ /[\S]{8}/) { dbg("IXHASH: Hash method #3 not computed - not enough non-space characters"); return undef; } my $body_copy = $body; $body_copy =~ s/[[:cntrl:][:space:]=]+//g; my $digest = md5_hex($body_copy); # Prevent duplicate hashing with Method #2 my $hash2 = compute2ndhash($body); if (defined $hash2 && $digest eq $hash2) { dbg("IXHASH: Skipping Hash #3 - Duplicate of Method #2"); return undef; } dbg("IXHASH: Computed Hash #3: $digest"); return $digest; } 1;