Milter plugin
git-svn-id: https://svn.perl.org/qpsmtpd/trunk@174 958fd67b-6ff1-0310-b445-bb7760255be9
This commit is contained in:
Matt Sergeant
parent
d70a5d31f0
commit
a1cf0ae556
2
Changes
2
Changes
@ -15,6 +15,8 @@
|
||||
|
||||
Enable "check_earlytalker" in the default plugins config
|
||||
|
||||
Added a milter plugin to allow use of sendmail milters
|
||||
|
||||
[.. todo, fill in older changes ..] spf changes etc?
|
||||
|
||||
0.26 - 2003/06/11
|
||||
|
||||
226
plugins/milter
Normal file
226
plugins/milter
Normal file
@ -0,0 +1,226 @@
|
||||
=head1 NAME
|
||||
|
||||
milter
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This plugin allows you to attach to milter filters (yes, those written for
|
||||
sendmail) as though they were qpsmtpd plugins.
|
||||
|
||||
In order to do this you need the C<Net::Milter> module from CPAN.
|
||||
|
||||
=head1 CONFIG
|
||||
|
||||
It takes two required parameters - a milter name (for logging) and the port
|
||||
to connect to on the localhost. This can also contain a hostname if
|
||||
the filter is on another machine:
|
||||
|
||||
queue/milter Brightmail 5513
|
||||
|
||||
or
|
||||
|
||||
queue/milter Brightmail bmcluster:5513
|
||||
|
||||
This plugin has so far only been tested with Brightmail's milter module.
|
||||
|
||||
=cut
|
||||
|
||||
use Net::Milter;
|
||||
no warnings;
|
||||
|
||||
sub register {
|
||||
my ($self, $qp, @args) = @_;
|
||||
|
||||
die "Invalid milter setup args: '@args'" unless @args > 1;
|
||||
my ($name, $port) = @args;
|
||||
my $host = '127.0.0.1';
|
||||
if ($port =~ s/^(.*)://) {
|
||||
$host = $1;
|
||||
}
|
||||
|
||||
$self->{name} = $name;
|
||||
$self->{host} = $host;
|
||||
$self->{port} = $port;
|
||||
|
||||
$self->register_hook("connect", "connect_handler");
|
||||
$self->register_hook("helo", "helo_handler");
|
||||
$self->register_hook("mail", "mail_handler");
|
||||
$self->register_hook("rcpt", "rcpt_handler");
|
||||
$self->register_hook("data_post", "data_handler");
|
||||
$self->register_hook("disconnect", "disconnect_handler");
|
||||
}
|
||||
|
||||
sub disconnect_handler {
|
||||
my ($self) = @_;
|
||||
|
||||
my $milter = $self->qp->connection->notes('milter') || return DECLINED;
|
||||
$milter->send_quit();
|
||||
|
||||
$self->qp->connection->notes('spam', undef);
|
||||
$self->qp->connection->notes('milter', undef);
|
||||
|
||||
return DECLINED;
|
||||
}
|
||||
|
||||
sub check_results {
|
||||
my ($self, $transaction, $where, @results) = @_;
|
||||
foreach my $result (@results) {
|
||||
next if $result->{action} eq 'continue';
|
||||
$self->log(1, "milter $self->{name} result action: $result->{action}");
|
||||
if ($result->{action} eq 'reject') {
|
||||
die("Rejected at $where by $self->{name} milter ($result->{explanation})");
|
||||
}
|
||||
elsif ($result->{action} eq 'add') {
|
||||
if ($result->{header} eq 'body') {
|
||||
$transaction->body_write($result->{value});
|
||||
}
|
||||
else {
|
||||
$transaction->header->add($result->{header}, $result->{value});
|
||||
}
|
||||
}
|
||||
elsif ($result->{action} eq 'delete') {
|
||||
$transaction->header->delete($result->{header});
|
||||
}
|
||||
elsif ($result->{action} eq 'accept') {
|
||||
# TODO - figure out what this is used for
|
||||
}
|
||||
elsif ($result->{action} eq 'replace') {
|
||||
$transaction->header->replace($result->{header}, $result->{value});
|
||||
}
|
||||
elsif ($result->{action} eq 'continue') {
|
||||
# just carry on as normal
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
sub connect_handler {
|
||||
my ($self, $transaction) = @_;
|
||||
|
||||
$self->log(1, "milter $self->{name} opening connection to milter backend");
|
||||
my $milter = Net::Milter->new();
|
||||
$milter->open($self->{host}, $self->{port}, 'tcp');
|
||||
$milter->protocol_negotiation();
|
||||
|
||||
$self->qp->connection->notes(milter => $milter);
|
||||
|
||||
my $remote_ip = $self->qp->connection->remote_ip;
|
||||
my $remote_host = $self->qp->connection->remote_host;
|
||||
$self->log(1, "milter $self->{name} checking connect from $remote_host\[$remote_ip\]");
|
||||
|
||||
eval {
|
||||
$self->check_results($transaction, "connection",
|
||||
$milter->send_connect($remote_host, 'tcp4', 0, $remote_ip));
|
||||
};
|
||||
$self->qp->connection->notes('spam', $@) if $@;
|
||||
|
||||
return DECLINED;
|
||||
}
|
||||
|
||||
sub helo_handler {
|
||||
my ($self, $transaction) = @_;
|
||||
|
||||
if (my $txt = $self->qp->connection->notes('spam')) {
|
||||
return DENY, $txt;
|
||||
}
|
||||
|
||||
my $milter = $self->qp->connection->notes('milter');
|
||||
|
||||
my $helo = $self->qp->connection->hello;
|
||||
my $host = $self->qp->connection->hello_host;
|
||||
|
||||
$self->log(1, "milter $self->{name} checking HELO $host");
|
||||
|
||||
eval { $self->check_results($transaction, "HELO",
|
||||
$milter->send_helo($host)) };
|
||||
return(DENY, $@) if $@;
|
||||
|
||||
return DECLINED;
|
||||
}
|
||||
|
||||
sub mail_handler {
|
||||
my ($self, $transaction, $address) = @_;
|
||||
|
||||
my $milter = $self->qp->connection->notes('milter');
|
||||
|
||||
$self->log(1, "milter $self->{name} checking MAIL FROM " . $address->format);
|
||||
eval { $self->check_results($transaction, "MAIL FROM",
|
||||
$milter->send_mail_from($address->format)) };
|
||||
return(DENY, $@) if $@;
|
||||
|
||||
return DECLINED;
|
||||
}
|
||||
|
||||
sub rcpt_handler {
|
||||
my ($self, $transaction, $address) = @_;
|
||||
|
||||
my $milter = $self->qp->connection->notes('milter');
|
||||
|
||||
$self->log(1, "milter $self->{name} checking RCPT TO " . $address->format);
|
||||
|
||||
eval { $self->check_results($transaction, "RCPT TO",
|
||||
$milter->send_rcpt_to($address->format)) };
|
||||
return(DENY, $@) if $@;
|
||||
|
||||
return DECLINED;
|
||||
}
|
||||
|
||||
sub data_handler {
|
||||
my ($self, $transaction) = @_;
|
||||
|
||||
my $milter = $self->qp->connection->notes('milter');
|
||||
|
||||
$self->log(1, "milter $self->{name} checking headers");
|
||||
|
||||
my $headers = $transaction->header(); # Mail::Header object
|
||||
foreach my $h ($headers->tags) {
|
||||
# munge these headers because milters prefer them this way
|
||||
$h =~ s/\b(\w)/\U$1/g;
|
||||
$h =~ s/\bid\b/ID/g;
|
||||
foreach my $val ($headers->get($h)) {
|
||||
# $self->log(1, "milter $self->{name} checking header: $h: $val");
|
||||
eval { $self->check_results($transaction, "header $h",
|
||||
$milter->send_header($h, $val)) };
|
||||
return(DENY, $@) if $@;
|
||||
}
|
||||
}
|
||||
|
||||
eval { $self->check_results($transaction, "end headers",
|
||||
$milter->send_end_headers()) };
|
||||
return(DENY, $@) if $@;
|
||||
|
||||
$transaction->body_resetpos;
|
||||
|
||||
# skip past headers
|
||||
while (my $line = $transaction->body_getline) {
|
||||
$line =~ s/\r?\n//;
|
||||
$line =~ s/\s*$//;
|
||||
last unless length($line);
|
||||
}
|
||||
|
||||
$self->log(1, "milter $self->{name} checking body");
|
||||
|
||||
my $data = '';
|
||||
while (my $line = $transaction->body_getline) {
|
||||
$data .= $line;
|
||||
if (length($data) > 60000) {
|
||||
eval { $self->check_results($transaction, "body",
|
||||
$milter->send_body($data)) };
|
||||
return(DENY, $@) if $@;
|
||||
$data = '';
|
||||
}
|
||||
}
|
||||
|
||||
if (length($data)) {
|
||||
eval { $self->check_results($transaction, "body",
|
||||
$milter->send_body($data)) };
|
||||
return(DENY, $@) if $@;
|
||||
$data = '';
|
||||
}
|
||||
|
||||
eval { $self->check_results($transaction, "end of DATA",
|
||||
$milter->send_end_body()) };
|
||||
return(DENY, $@) if $@;
|
||||
|
||||
return DECLINED;
|
||||
}
|
||||
|
||||
Loading…
Reference in New Issue
Block a user