home *** CD-ROM | disk | FTP | other *** search
/ ftp.f-secure.com / 2014.06.ftp.f-secure.com.tar / ftp.f-secure.com / support / hotfix / fsis / IS-SpamControl.fsfix / iufssc / lib / FS / FromSPF.pm < prev    next >
Text File  |  2006-11-29  |  4KB  |  192 lines
  1. # FS::FromSPF.pm -- era Tue Sep  6 03:42:25 PM 2005
  2. # $Id: FromSPF.pm 3971 2006-10-17 07:34:01Z eriker $
  3. # Copyright (C) 2005 F-Secure Corporation
  4.  
  5. =head1 NAME
  6.  
  7. FS::FromSPF - SpamAssassin plugin for SPF check of From: header
  8.  
  9. =head1 SYNOPSIS
  10.  
  11.   loadplugin   FS::FromSPF
  12.  
  13.   header   SPF_FROM_FAIL_PAYBAY eval:from_spf_fail("paypal.com", "ebay.com")
  14.   describe SPF_FROM_FAIL_PAYBAY From: PayPal/Ebay, but fails their SPF
  15.   score    SPF_FROM_FAIL_PAYBAY 9
  16.   tflags   SPF_FROM_FAIL_PAYBAY net
  17.  
  18. =head1 DESCRIPTION
  19.  
  20. B<FS::FromSPF> checks the domain on the From: header
  21. against the domains listed in the call to B<eval:from_spf_fail>,
  22. and if it matches, it goes ahead and performs an SPF lookup
  23. against the domain in the From: header.
  24. If the SPF check returns a 'softfail' or 'fail' status,
  25. or even 'neutral',
  26. the corresponding rule triggers.
  27.  
  28. =cut
  29.  
  30. # Cruft cased and pasted from Mail::SpamAssassin::Plugin::Test
  31.  
  32. package FS::FromSPF;
  33.  
  34. use Mail::SpamAssassin::Plugin;
  35. use strict;
  36. use bytes;
  37.  
  38.  
  39. our @ISA = qw(Mail::SpamAssassin::Plugin);
  40. our $VERSION = '0.001';            ######## TODO: remember to update
  41.  
  42.  
  43. sub new {
  44.   my $class = shift;
  45.   my $mailsaobject = shift;
  46.  
  47.   # some boilerplate...
  48.   $class = ref($class) || $class;
  49.   my $self = $class->SUPER::new($mailsaobject);
  50.   bless ($self, $class);
  51.   $self->{conf} = $mailsaobject->{conf};
  52.  
  53.   $self->register_eval_rule ("from_spf_fail");
  54.  
  55.   dbg("plugin: registered FS::FromSPF plugin");
  56.   return $self;
  57. }
  58.  
  59.  
  60. use Mail::SPF::Query;
  61.  
  62. *dbg = *Mail::SpamAssassin::Plugin::dbg;
  63.  
  64. sub from_spf_fail
  65. {
  66.     my ($self, $permsgstatus, @args) = @_;
  67.  
  68.     die "from_spf_fail called without arguments" unless (@args);
  69.  
  70.     return unless $permsgstatus->is_dns_available();
  71.  
  72.     dbg("fromspf: from_spf_fail (" . join (";", @args) . ")");
  73.  
  74.     my $from = $permsgstatus->get ("From:addr");
  75.     my ($dom) = $from;
  76.     $dom =~ s/.*\@//;
  77.     my $fqdn =
  78.     lc(Mail::SpamAssassin::Util::RegistrarBoundaries::trim_domain ($dom));
  79.  
  80.     return 0 unless (grep { lc($_) eq $fqdn } @args);
  81.  
  82.     # Mostly case and paste from Mail::SpamAssassin::Plugin::SPF
  83.  
  84.     my $lasthop = $permsgstatus->{relays_untrusted}->[0];
  85.     unless (defined $lasthop)
  86.     {
  87.     dbg("fromspf: message was delivered entirely via trusted relays");
  88.     return 0;
  89.     }
  90.     # else
  91.  
  92.     my $ip = $lasthop->{ip};
  93.     my $helo = $lasthop->{helo};
  94.     dbg ("fromspf: querying $from [ip=$ip, helo=$helo]");
  95.  
  96.     my $query = Mail::SPF::Query->new (
  97.         ip => $ip,
  98.         sender => $from,
  99.         helo => $helo,
  100.         debug => $Mail::SpamAssassin::Debug->{rbl},
  101.         trusted => 1,
  102.         );
  103.  
  104.     my ($result, $comment);
  105.     my $timeout = 5;
  106.  
  107.     eval {
  108.     local $SIG{ALRM} = sub { die "__alarm__\n" };
  109.     alarm ($timeout);
  110.     ($result, $comment) = $query->result();
  111.     dbg ("fromspf: result '$result' ($comment)");
  112.     alarm (0);
  113.     };
  114.  
  115.     alarm (0);
  116.  
  117.     if ($@)
  118.     {
  119.     if ($@ =~ /^__alarm__$/)
  120.     {
  121.         dbg ("fromspf: lookup timed out after $timeout seconds.");
  122.     }
  123.     else
  124.     {
  125.         warn "FromSPF: lookup failed: $@\n";
  126.     }
  127.     return 0;
  128.     }
  129.     # else
  130.  
  131.     if ($result eq 'fail' || $result eq 'softfail' || $result eq 'neutral')
  132.     ######## FIXME: should we have this too? || ! $result)
  133.     {
  134.     $comment ||= '';
  135.     $comment =~ s/\s+/ /gs;
  136.     $permsgstatus->{from_spf_comment} = "FromSPF: '$result' ($comment)";
  137.     $permsgstatus->{from_spf_result} = $result;
  138.     return 1;
  139.     }
  140.     #else
  141.     return 0;
  142. }
  143.  
  144.  
  145. 1;
  146.  
  147.  
  148. =head1 BUGS
  149.  
  150. We are stretching the semantics of SPF here.
  151.  
  152. Checking the F<From:> header field is not
  153. supported in the basic SPF spec,
  154. although proposals codifying this
  155. have been circulated.
  156.  
  157. The plugin returns a match for
  158. 'softfail' or even 'neutral' --
  159. it should only be used for when
  160. you really, really require an
  161. affirmation from the SPF lookup.
  162. This is intended primarily for
  163. checking against domains which
  164. are very widely forged,
  165. and which publish well-formed
  166. SPF records.
  167. (The 'neutral' response might
  168. be given when the final
  169. SPF entry is F<?all> but there
  170. are other entries which
  171. would have returned a pass;
  172. we consider the fallback
  173. to be a failure indication
  174. in this case.)
  175.  
  176. =head1 SEE ALSO
  177.  
  178. L<Mail::SpamAssassin::Plugin>,
  179. L<Mail::SpamAssassin::Plugin::SPF>,
  180. L<Mail::SPF::Query>;
  181. L<http://spf.pobox.com/>;
  182. various SPF/From: extension proposals.
  183.  
  184. =head1 COPYRIGHT
  185.  
  186. Copyright (C) 2005 F-Secure Corp.
  187. L<http://www.f-secure.com>
  188.  
  189. All rights reserved.
  190.  
  191. =cut
  192.