f654defacb
mandate signing by policy for the moment). Change variables to use actual English words as names (instead of disemvoweled or truncated variants). Tweak Copyright notice to be current. git-svn-id: https://svn.perl.org/qpsmtpd/branches/0.3x@652 958fd67b-6ff1-0310-b445-bb7760255be9
110 lines
2.5 KiB
Plaintext
110 lines
2.5 KiB
Plaintext
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.
|