-----BEGIN PGP SIGNED MESSAGE----- Hash: SHA1
Michael, I'd be keen to. any chance you can check it into trunk? I was doing something similar but you beat me to it, so now it's time to do some merging ;) - --j. Michael Parker writes: > Howdy All, > > I spent a few minutes this morning working up the start of a > DomainKeys plugin. It uses the Mail::DomainKeys perl module to > perform the various checks. Honestly, Mail::DomainKeys may not be the > right direction. It has zero documentation and some oddities that > might make it difficult to use in the long run. > > Anyway, my knowledge of DomainKeys is almost nothing. The plugin > follows the example of how it is used in qpsmtpd. So, if anyone would > like to pitch in and polish this off, feel free. > > Michael > > =head1 NAME > > Mail::SpamAssassin::Plugin::DomainKeys > > =head1 SYNOPSIS > > loadplugin Mail::SpamAssassin::Plugin::DomainKeys [/path/to/DomainKeys.pm] > > full DOMAINKEY_DOMAIN eval:check_domainkeys_senderdomain() > > =head1 DESCRIPTION > > XXX > > =head1 AUTHOR > > Michael Parker <[EMAIL PROTECTED]> > > =head1 COPYRIGHT > > Copyright (c) 2005 Michael Parker. All rights reserved. > > Licensed under the Apache License, Version 2.0 (the "License"); > you may not use this file except in compliance with the License. > You may obtain a copy of the License at > > http://www.apache.org/licenses/LICENSE-2.0 > > Unless required by applicable law or agreed to in writing, software > distributed under the License is distributed on an "AS IS" BASIS, > WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. > See the License for the specific language governing permissions and > limitations under the License. > > =cut > > package Mail::SpamAssassin::Plugin::DomainKeys; > > use Mail::SpamAssassin::Plugin; > use strict; > use warnings; > use bytes; > > use Mail::DomainKeys::Message; > use Mail::DomainKeys::Policy; > > use vars qw(@ISA); > @ISA = qw(Mail::SpamAssassin::Plugin); > > # constructor: register the eval rule > sub new { > my $class = shift; > my $mailsaobject = shift; > > $class = ref($class) || $class; > my $self = $class->SUPER::new($mailsaobject); > bless ($self, $class); > > $self->register_eval_rule ("check_domainkeys_senderdomain"); > $self->register_eval_rule ("check_domainkeys_verified"); > $self->register_eval_rule ("check_domainkeys_notsignedok"); > $self->register_eval_rule ("check_domainkeys_testing"); > $self->register_eval_rule ("check_domainkeys_signall"); > > return $self; > } > > sub check_domainkeys_senderdomain { > my ($self, $permsgstatus) = @_; > > $self->_check_domainkeys($permsgstatus) unless > $permsgstatus->{domainkeys_checked}; > > return $permsgstatus->{domainkeys_found}; > } > > sub check_domainkeys_verified { > my ($self, $permsgstatus) = @_; > > $self->_check_domainkeys($permsgstatus) unless > $permsgstatus->{domainkeys_checked}; > > return $permsgstatus->{domainkeys_verified}; > } > > sub check_domainkeys_notsignedok { > my ($self, $permsgstatus) = @_; > > $self->_check_domainkeys($permsgstatus) unless > $permsgstatus->{domainkeys_checked}; > > return $permsgstatus->{domainkeys_notsignedok}; > } > > sub check_domainkeys_testing { > my ($self, $permsgstatus) = @_; > > $self->_check_domainkeys($permsgstatus) unless > $permsgstatus->{domainkeys_checked}; > > return $permsgstatus->{domainkeys_testing}; > } > > sub check_domainkeys_signall { > my ($self, $permsgstatus) = @_; > > $self->_check_domainkeys($permsgstatus) unless > $permsgstatus->{domainkeys_checked}; > > return $permsgstatus->{domainkeys_signall}; > } > > sub _check_domainkeys { > my ($self, $permsgstatus) = @_; > > my $header = $permsgstatus->{msg}->get_pristine_header(); > my $body = $permsgstatus->{msg}->get_body(); > > my $message = Mail::DomainKeys::Message->load(HeadString => $header, > BodyReference => $body); > > return unless $message; > > $permsgstatus->{domainkeys_checked} = 1; > > # does a sender domain header exist? > return unless $message->senderdomain(); > > $permsgstatus->{domainkeys_found} = 1; > > # verified > if ($message->signed() && $message->verify()) { > $permsgstatus->{domainkeys_verified} = 1; > } > > my $policy = Mail::DomainKeys::Policy->fetch(Policy => 'dns', > Domain => > $message->senderdomain()); > > return unless $policy; > > # not signed and domain doesn't sign all > if ($policy->signsome() && !$message->signed()) { > $permsgstatus->{domainkeys_notsignedok} = 1; > } > > # domain or key testing > if ($message->testing() || $policy->testing()) { > $permsgstatus->{domainkeys_testing} = 1; > } > > # does policy require all mail to be signed > if ($policy->signall()) { > $permsgstatus->{domainkeys_signall} = 1; > } > > return; > } > > 1; > > --=_mail-22362-1105844823-0001-2 > Content-Type: application/pgp-signature > Content-Transfer-Encoding: 7bit > Content-Disposition: inline > > -----BEGIN PGP SIGNATURE----- > Version: GnuPG v1.0.7 (GNU/Linux) > > iD8DBQFB6dpXG4km+uS4gOIRApuwAJ9XrdG5qv/qAKu/EpGS7YrATOVyWACgi6YI > K0b34me1w0EJJq4a8b2i4v8�7/ > -----END PGP SIGNATURE----- > > --=_mail-22362-1105844823-0001-2-- -----BEGIN PGP SIGNATURE----- Version: GnuPG v1.2.5 (GNU/Linux) Comment: Exmh CVS iD8DBQFB7c2cMJF5cimLx9ARAotvAJsEb6ByffG00G/ZpEQuzEKl0xtWggCguW66 rb71o7zldO2igv1poVjLAn4= =Wyxn -----END PGP SIGNATURE-----
