--- lib/Mail/SpamAssassin/Plugin/DKIM.pm	(revision 925052)

+++ lib/Mail/SpamAssassin/Plugin/DKIM.pm	(working copy)

@@ -213,6 +213,19 @@

 in the SpamAssassin distribution.  The whitelist score is lower, because

 these are often targets for abuse of public mailers which sign their mail.

+=item unwhitelist_from_dkim author@example.com

+

+Removes an email address from def_whitelist_from_dkim and whitelist_from_dkim

+tables, if it exists. Useful for removing undesired default entries from a

+distributed configuration file by a local.cf file or by a C<user_prefs>.

+Note that a parameter is a single email address - currently that address

+is removed regardless of a signing-domain which may have been specified in a

+whitelisting entry.

+

+The specified email address has to match exactly the address previously

+used in a whitelist_from_dkim or def_whitelist_from_dkim directive

+(with an exception that its domain name part is matched case-insensitively).

+

 =item adsp_override domain [signing-practices]

 Currently few domains publish their signing practices (RFC 5617 - ADSP),

@@ -362,6 +375,7 @@

       }

       my $address = $1;

       my $sdid = defined $2 ? $2 : '';  # empty implies author domain signature

+      $address =~ s/(\@[^@]*)\z/lc($1)/e; # lowercase the email address domain

       $self->{parser}->add_to_addrlist_rcvd('whitelist_from_dkim',

                                             $address, $sdid);

     }

@@ -381,12 +395,32 @@

       }

       my $address = $1;

       my $sdid = defined $2 ? $2 : '';  # empty implies author domain signature

+      $address =~ s/(\@[^@]*)\z/lc($1)/e; # lowercase the email address domain

       $self->{parser}->add_to_addrlist_rcvd('def_whitelist_from_dkim',

                                             $address, $sdid);

     }

   });

   push (@cmds, {

+    setting => 'unwhitelist_from_dkim',

+    type => $Mail::SpamAssassin::Conf::CONF_TYPE_ADDRLIST,

+    code => sub {

+      my ($self, $key, $value, $line) = @_;

+      unless (defined $value && $value !~ /^$/) {

+        return $Mail::SpamAssassin::Conf::MISSING_REQUIRED_VALUE;

+      }

+      unless ($value =~ /^\S+$/) {

+        return $Mail::SpamAssassin::Conf::INVALID_VALUE;

+      }

+      $value =~ s/(\@[^@]*)\z/lc($1)/e;  # lowercase the email address domain

+      $self->{parser}->remove_from_addrlist_rcvd('whitelist_from_dkim',

+                                                 $value);

+      $self->{parser}->remove_from_addrlist_rcvd('def_whitelist_from_dkim',

+                                                 $value);

+    }

+  });

+

+  push (@cmds, {

     setting => 'adsp_override',

     type => $Mail::SpamAssassin::Conf::CONF_TYPE_HASH_KEY_VALUE,

     code => sub {

Index: lib/Mail/SpamAssassin/HTML.pm

===================================================================

--- lib/Mail/SpamAssassin/HTML.pm	(revision 943932)

+++ lib/Mail/SpamAssassin/HTML.pm	(revision 943933)

@@ -191,7 +191,7 @@

   my $self = shift;

   my %options = @_;

-  return join('', @{ $self->{text} }) unless keys %options;

+  return join('', @{ $self->{text} }) unless %options;

   my $mask;

   while (my ($k, $v) = each %options) {

Index: lib/Mail/SpamAssassin/Dns.pm

===================================================================

--- lib/Mail/SpamAssassin/Dns.pm	(revision 943932)

+++ lib/Mail/SpamAssassin/Dns.pm	(revision 943933)

@@ -754,7 +754,7 @@

   dbg("dns: entering helper-app run mode");

   $self->{old_slash} = $/;              # Razor pollutes this

   %{$self->{old_env}} = ();

-  if ( defined %ENV ) {

+  if ( %ENV ) {

     # undefined values in %ENV can result due to autovivification elsewhere,

     # this prevents later possible warnings when we restore %ENV

     while (my ($key, $value) = each %ENV) {

Index: lib/Mail/SpamAssassin/Plugin/Check.pm

===================================================================

--- lib/Mail/SpamAssassin/Plugin/Check.pm	(revision 943932)

+++ lib/Mail/SpamAssassin/Plugin/Check.pm	(revision 943933)

@@ -307,64 +307,51 @@

   my $package_name = __PACKAGE__;

   my $methodname = $package_name."::_".$ruletype."_tests_".$clean_priority;

-  if (defined &{$methodname} && !$doing_user_rules) {

-run_compiled_method:

-  # dbg("rules: run_generic_tests - calling %s", $methodname);

-    my $t = Mail::SpamAssassin::Timeout->new({ deadline => $master_deadline });

-    my $err = $t->run(sub {

-      no strict "refs";

-      $methodname->($pms, @{$opts{args}});

-    });

-    if ($t->timed_out() && $master_deadline && time > $master_deadline) {

-      info("check: exceeded time limit in $methodname, skipping further tests");

-      $pms->{deadline_exceeded} = 1;

-    }

-    return;

-  }

+  if (!defined &{$methodname} || $doing_user_rules) {

-  # use %nopts for named parameter-passing; it's more friendly to future-proof

-  # subclassing, since new parameters can be added without breaking third-party

-  # subclassed implementations of this plugin.

-  my %nopts = (

-    ruletype => $ruletype,

-    doing_user_rules => $doing_user_rules,

-    priority => $priority,

-    clean_priority => $clean_priority

-  );

+    # use %nopts for named parameter-passing; it's more friendly

+    # to future-proof subclassing, since new parameters can be added without

+    # breaking third-party subclassed implementations of this plugin.

+    my %nopts = (

+      ruletype => $ruletype,

+      doing_user_rules => $doing_user_rules,

+      priority => $priority,

+      clean_priority => $clean_priority

+    );

-  # build up the eval string...

-  $self->{evalstr_methodname} = $methodname;

-  $self->{evalstr_chunk_current_methodname} = undef;

-  $self->{evalstr_chunk_methodnames} = [];

-  $self->{evalstr_chunk_prefix} = [];  # stack (array) of source code sections

-  $self->{evalstr} = ''; $self->{evalstr_l} = 0;

-  $self->{evalstr2} = '';

-  $self->begin_evalstr_chunk($pms);

+    # build up the eval string...

+    $self->{evalstr_methodname} = $methodname;

+    $self->{evalstr_chunk_current_methodname} = undef;

+    $self->{evalstr_chunk_methodnames} = [];

+    $self->{evalstr_chunk_prefix} = []; # stack (array) of source code sections

+    $self->{evalstr} = ''; $self->{evalstr_l} = 0;

+    $self->{evalstr2} = '';

+    $self->begin_evalstr_chunk($pms);

-  $self->push_evalstr_prefix($pms, '

-      # start_rules_plugin_code '.$ruletype.' '.$priority.'

-      my $scoresptr = $self->{conf}->{scores};

-  ');

-  if (defined $opts{pre_loop_body}) {

-    $opts{pre_loop_body}->($self, $pms, $conf, %nopts);

-  }

-  $self->add_evalstr($pms,

-                     $self->start_rules_plugin_code($ruletype, $priority) );

-  while (my($rulename, $test) = each %{$opts{testhash}->{$priority}}) {

-    $opts{loop_body}->($self, $pms, $conf, $rulename, $test, %nopts);

-  }

-  if (defined $opts{post_loop_body}) {

-    $opts{post_loop_body}->($self, $pms, $conf, %nopts);

-  }

+    $self->push_evalstr_prefix($pms, '

+        # start_rules_plugin_code '.$ruletype.' '.$priority.'

+        my $scoresptr = $self->{conf}->{scores};

+    ');

+    if (defined $opts{pre_loop_body}) {

+      $opts{pre_loop_body}->($self, $pms, $conf, %nopts);

+    }

+    $self->add_evalstr($pms,

+                       $self->start_rules_plugin_code($ruletype, $priority) );

+    while (my($rulename, $test) = each %{$opts{testhash}->{$priority}}) {

+      $opts{loop_body}->($self, $pms, $conf, $rulename, $test, %nopts);

+    }

+    if (defined $opts{post_loop_body}) {

+      $opts{post_loop_body}->($self, $pms, $conf, %nopts);

+    }

-  $self->flush_evalstr($pms, 'run_generic_tests');

-  $self->free_ruleset_source($pms, $ruletype, $priority);

+    $self->flush_evalstr($pms, 'run_generic_tests');

+    $self->free_ruleset_source($pms, $ruletype, $priority);

-  # clear out a previous version of this method

-  undef &{$methodname};

+    # clear out a previous version of this method

+    undef &{$methodname};

-  # generate the loop that goes through each line...

-  my $evalstr = <<"EOT";

+    # generate the loop that goes through each line...

+    my $evalstr = <<"EOT";

   {

     package $package_name;

@@ -373,41 +360,52 @@

     sub $methodname {

 EOT

-  for my $chunk_methodname (@{$self->{evalstr_chunk_methodnames}}) {

-    $evalstr .= "      $chunk_methodname(\@_);\n";

-  }

+    for my $chunk_methodname (@{$self->{evalstr_chunk_methodnames}}) {

+      $evalstr .= "      $chunk_methodname(\@_);\n";

+    }

-  $evalstr .= <<"EOT";

+    $evalstr .= <<"EOT";

     }

     1;

   }

 EOT

-  delete $self->{evalstr};   # free up some RAM before we eval()

-  delete $self->{evalstr2};

-  delete $self->{evalstr_methodname};

-  delete $self->{evalstr_chunk_current_methodname};

-  delete $self->{evalstr_chunk_methodnames};

-  delete $self->{evalstr_chunk_prefix};

+    delete $self->{evalstr};   # free up some RAM before we eval()

+    delete $self->{evalstr2};

+    delete $self->{evalstr_methodname};

+    delete $self->{evalstr_chunk_current_methodname};

+    delete $self->{evalstr_chunk_methodnames};

+    delete $self->{evalstr_chunk_prefix};

-  dbg("rules: run_generic_tests - compiling eval code: %s, priority %s",

-      $ruletype, $priority);

-# dbg("rules: eval code to compile: $evalstr");

-  my $eval_result;

-  { my $timer = $self->{main}->time_method('compile_gen');

-    $eval_result = eval($evalstr);

-  }

-  if (!$eval_result) {

-    my $eval_stat = $@ ne '' ? $@ : "errno=$!";  chomp $eval_stat;

-    warn "rules: failed to compile $ruletype tests, skipping:\n".

-         "\t($eval_stat)\n";

-    $pms->{rule_errors}++;

-  }

-  else {

+    dbg("rules: run_generic_tests - compiling eval code: %s, priority %s",

+        $ruletype, $priority);

+  # dbg("rules: eval code to compile: $evalstr");

+    my $eval_result;

+    { my $timer = $self->{main}->time_method('compile_gen');

+      $eval_result = eval($evalstr);

+    }

+    if (!$eval_result) {

+      my $eval_stat = $@ ne '' ? $@ : "errno=$!";  chomp $eval_stat;

+      warn "rules: failed to compile $ruletype tests, skipping:\n".

+           "\t($eval_stat)\n";

+      $pms->{rule_errors}++;

+      return;

+    }

     dbg("rules: compiled $ruletype tests");

-    goto run_compiled_method;

   }

+

+#run_compiled_method:

+# dbg("rules: run_generic_tests - calling %s", $methodname);

+  my $t = Mail::SpamAssassin::Timeout->new({ deadline => $master_deadline });

+  my $err = $t->run(sub {

+    no strict "refs";

+    $methodname->($pms, @{$opts{args}});

+  });

+  if ($t->timed_out() && $master_deadline && time > $master_deadline) {

+    info("check: exceeded time limit in $methodname, skipping further tests");

+    $pms->{deadline_exceeded} = 1;

+  }

 }

 sub begin_evalstr_chunk {

Index: lib/Mail/SpamAssassin/Plugin/BodyEval.pm

===================================================================

--- lib/Mail/SpamAssassin/Plugin/BodyEval.pm	(revision 943932)

+++ lib/Mail/SpamAssassin/Plugin/BodyEval.pm	(revision 943933)

@@ -119,7 +119,7 @@

         }

 	# If there are no words, mark if there's at least 1 image ...

-	if (keys %html == 0 && exists $pms->{html}{inside}{img}) {

+	if (!%html && exists $pms->{html}{inside}{img}) {

 	  # Use "\n" as the mark since it can't ever occur normally

 	  $html{"\n"}=1;

 	}

Index: lib/Mail/SpamAssassin/Plugin/MIMEEval.pm

===================================================================

--- lib/Mail/SpamAssassin/Plugin/MIMEEval.pm	(revision 929342)

+++ lib/Mail/SpamAssassin/Plugin/MIMEEval.pm	(revision 929343)

@@ -498,7 +498,7 @@

     # perhaps just limit to test, and image?

     next if ($ctype eq 'application/ics');

-    my $cte = lc $p->get_header('content-transfer-encoding') || '';

+    my $cte = lc($p->get_header('content-transfer-encoding') || '');

     next if ($cte !~ /^base64$/);

     foreach my $l ( @{$p->raw()} ) {

       my $len = length $l;

BUG 6488 - Lint errors with Perl 5.12.1 in AntiVirus.pm

Index: lib/Mail/SpamAssassin/Plugin/AntiVirus.pm

=========================================================================

--- lib/Mail/SpamAssassin/Plugin/AntiVirus.pm	(revision 574664)

+++ lib/Mail/SpamAssassin/Plugin/AntiVirus.pm	(revision 1028149)

@@ -98,9 +98,9 @@

     my ($ctype, $boundary, $charset, $name) =

       Mail::SpamAssassin::Util::parse_content_type($p->get_header('content-type'));

-    $name = lc $name || '';

+    $name = lc($name || '');

-    my $cte = lc $p->get_header('content-transfer-encoding') || '';

+    my $cte = lc($p->get_header('content-transfer-encoding') || '');

     $ctype = lc $ctype;

     if ($name && $name =~ /\.(?:ade|adp|asx|bas|bat|chm|cmd|com|cpl|crt|dll|exe|hlp|hta|inf|ins|isp|js|jse|lnk|mda|mdb|mde|mdt|mdw|mdz|msc|msi|msp|mst|nws|ops|pcd|pif|prf|reg|scf|scr\??|sct|shb|shs|shm|swf|url|vb|vbe|vbs|vbx|vxd|wsc|wsf|wsh)$/)