sub hook_data_post { use Mail::DomainKeys::Message; use Mail::DomainKeys::Policy; my ($self, $transaction) = @_; # if this isn't signed, just move along return DECLINED unless $transaction->header->get('DomainKey-Signature'); my @body; $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 $self->log(LOGWARN, "unable to load message"), return DECLINED; # no sender domain means no verification $message->senderdomain or return DECLINED; my $status; # key testing if ( $message->testing ) { # Don't do anything else $status = "testing"; } elsif ( $message->signed ) { if ( $message->verify ) { # verified: add good header $status = $message->signature->status; } else { # not verified, i.e. forged signature $status = undef; } } else { # not signed 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 = "no signature"; } } if ( defined $status ) { $transaction->header->replace("DomainKey-Status", $status); return DECLINED; } else { return DENY, "DomainKeys signature failed to verify"; } } # Leave this in place until Mail::DomainKeys is patched eval q/ *Mail::DomainKeys::Message::header = sub { my $self = shift; $self->signed or return new Mail::DomainKeys::Header( Line => "DomainKey-Status: no signature"); $self->signature->status and return new Mail::DomainKeys::Header( Line => "DomainKey-Status: " . $self->signature->status); }; / unless Mail::DomainKeys::Message->can('header'); =cut =head1 NAME domainkeys: validate a DomainKeys signature on an incoming mail Copyright (C) 2005-2006 John Peacock. 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.