domainkeys: added reject & reject_type options.

backwards compatible with previous warn_only option.

added additional logging

refactored out a couple new subs.

minor changes: added strictures, warnings, moved 'use' statements to top of code

plugins/domainkeys

@@ -6,16 +6,28 @@ domainkeys: validate a DomainKeys signature on an incoming mail
 
 =head1 SYNOPSIS
 
-  domainkeys [warn_only 1]
+  domainkeys [reject 1]
 
-Performs a DomainKeys validation on the message.  Takes a single
+Performs a DomainKeys validation on the message.
-configuration
 
-  warn_only 1
+=head1 CONFIGURATION
 
-which means that messages which are not correctly signed (i.e. signed but
+=head2 reject
-modified or deliberately forged) will not be DENY'd, but an error will still
+
-be issued to the logfile.
+  reject 1
+
+Reject is a boolean that toggles message rejection on or off. Messages failing
+DomainKeys validation are rejected by default.
+
+=head2 reject_type
+
+  reject_type [ temp | perm ]
+
+The default rejection type is permanent.
+
+=head2 warn_only
+
+A deprecated option that disables message rejection. See reject instead.
 
 =head1 COPYRIGHT
 
@@ -25,95 +37,116 @@ Portions Copyright (C) 2004 Anthony D. Urso.  All rights reserved.  This
 program is free software; you can redistribute it and/or modify it under
 the same terms as Perl itself.
 
+=head1 AUTHORS
+
+ Matt Simerson    - 2012
+ John Peacock     - 2005-2006
+ Anthony D. Urso. - 2004
+
 =cut
 
+use strict;
+use warnings;
+
+use Qpsmtpd::Constants;
+
+use Mail::DomainKeys::Message;
+use Mail::DomainKeys::Policy;
+
 sub init {
     my ($self, $qp, %args) = @_;
 
     foreach my $key ( %args ) {
         $self->{$key} = $args{$key};
     }
+    $self->{reject} = 1 if ! defined $self->{reject};  # default reject
+    $self->{reject_type} = 'perm' if ! defined $self->{reject_type};
+
+    if ( $args{'warn_only'} ) {
+        $self->log(LOGNOTICE, "warn_only is deprecated. Use reject instead");
+        $self->{'reject'} = 0;
+    };
 }
 
 sub hook_data_post {
-    use Mail::DomainKeys::Message;
-    use Mail::DomainKeys::Policy;
-
     my ($self, $transaction) = @_;
 
-    # if this isn't signed, just move along
+    if ( ! $transaction->header->get('DomainKey-Signature') ) {
-    return DECLINED
+        $self->log(LOGINFO, "skip: unsigned");
-    	unless $transaction->header->get('DomainKey-Signature');
+        return DECLINED;
+    };
 	
-    my @body;
+    my $body = $self->assemble_body( $transaction );
-
-    $transaction->body_resetpos;
-
-    $transaction->body_getline; # \r\n seperator is NOT part of the body
-
-    while (my $line = $transaction->body_getline) {
-        push @body, $line;
-    }
 
     my $message = load Mail::DomainKeys::Message(
         HeadString => $transaction->header->as_string,
-        BodyReference => \@body) or
+        BodyReference => $body) or do {
-            $self->log(LOGWARN, "unable to load message"),
+            $self->log(LOGWARN, "skip: unable to load message"),
             return DECLINED;
+        };
 
-    # no sender domain means no verification 
+    # no sender domain means no verification
-    $message->senderdomain or
+    if ( ! $message->senderdomain ) {
+        $self->log(LOGINFO, "skip: failed to parse sender domain"),
         return DECLINED;
+    };
 
-    my $status;
+    my $status = $self->get_message_status( $message );
 
-    # key testing
-    if ( $message->testing ) {
-	# Don't do anything else
-	$status = "testing";
-    }
-    elsif ( $message->signed and $message->verify ) {
-	# verified: add good header
-	$status = $message->signature->status;
-    }
-    else { # not signed or not verified
-	my $policy = fetch Mail::DomainKeys::Policy(
-	    Protocol => "dns",
-	    Domain => $message->senderdomain
-	);
-	if ( $policy ) {
-	    if ( $policy->testing ) {
-		# Don't do anything else
-		$status = "testing";
-	    }
-	    elsif ( $policy->signall ) {
-		# if policy requires all mail to be signed
-		$status = undef;
-	    }
-	    else { # $policy->signsome
-		# not signed and domain doesn't sign all
-		$status = "no signature";
-	    }
-	}
-	else {
-	    $status = $message->signed ? "non-participant" : "no signature";
-	}
-    }
-
-    
     if ( defined $status ) {
-	$transaction->header->replace("DomainKey-Status", $status);
+        $transaction->header->replace("DomainKey-Status", $status);
-	$self->log(LOGWARN, "DomainKeys-Status: $status");
+        $self->log(LOGINFO, "pass: $status");
-	return DECLINED;
+        return DECLINED;
-    }
+    };
-    else {	
+
-	$self->log(LOGERROR, "DomainKeys signature failed to verify");
+    $self->log(LOGERROR, "fail: signature failed to verify");
-	if ( $self->{warn_only} ) {
+    return DECLINED if ! $self->{reject};
-	    return DECLINED;
+    my $deny = $self->{reject_type} eq 'temp' ? DENYSOFT : DENY;
-	}
+    return ($deny, "DomainKeys signature failed to verify");
-	else {
-	    return (DENY, "DomainKeys signature failed to verify");
-	}
-    }
 }
 
+sub get_message_status {
+    my ($self, $message) = @_;
+
+    if ( $message->testing ) {
+        return "testing";   # key testing, don't do anything else
+    };
+
+    if ( $message->signed && $message->verify ) {
+        return $message->signature->status; # verified: add good header
+    };
+
+    # not signed or not verified
+    my $policy = fetch Mail::DomainKeys::Policy(
+        Protocol => 'dns',
+        Domain => $message->senderdomain
+    );
+
+    if ( ! $policy ) {
+        return $message->signed ? "non-participant" : "no signature";
+    };
+
+    if ( $policy->testing ) {
+        return "testing";  # Don't do anything else
+    };
+
+    if ( $policy->signall ) {
+        return undef;      # policy requires all mail to be signed
+    };
+
+    # $policy->signsome
+    return "no signature"; # not signed and domain doesn't sign all
+};
+
+sub assemble_body {
+    my ($self, $transaction) = @_;
+
+    $transaction->body_resetpos;
+    $transaction->body_getline; # \r\n seperator is NOT part of the body
+
+    my @body;
+    while (my $line = $transaction->body_getline) {
+        push @body, $line;
+    }
+    return \@body;
+};