Added Postfix queue plugin thanks to Peter J Holzer!
git-svn-id: https://svn.perl.org/qpsmtpd/trunk@205 958fd67b-6ff1-0310-b445-bb7760255be9
This commit is contained in:
parent
72a4a024fe
commit
5abf363c34
2
Changes
2
Changes
@ -1,5 +1,7 @@
|
||||
0.27
|
||||
|
||||
Added Postfix queue plugin thanks to Peter J Holzer!
|
||||
|
||||
Took out the last "exit" call from the SMTP object; the "transport"
|
||||
module ("TcpServer", "SelectServer") needs to do the right thing in
|
||||
it's disconnect method.
|
||||
|
201
lib/Qpsmtpd/Postfix.pm
Normal file
201
lib/Qpsmtpd/Postfix.pm
Normal file
@ -0,0 +1,201 @@
|
||||
package Qpsmtpd::Postfix;
|
||||
|
||||
=head1 NAME
|
||||
|
||||
Qpsmtpd::Postfix
|
||||
|
||||
=head2 DESCRIPTION
|
||||
|
||||
This package implements the protocol Postfix servers use to communicate
|
||||
with each other. See src/global/rec_type.h in the postfix source for
|
||||
details.
|
||||
|
||||
=cut
|
||||
|
||||
use strict;
|
||||
use IO::Socket::UNIX;
|
||||
use vars qw(@ISA);
|
||||
@ISA = qw(IO::Socket::UNIX);
|
||||
|
||||
my %rec_types;
|
||||
|
||||
sub init {
|
||||
my ($self) = @_;
|
||||
|
||||
%rec_types = (
|
||||
REC_TYPE_SIZE => 'C', # first record, created by cleanup
|
||||
REC_TYPE_TIME => 'T', # time stamp, required
|
||||
REC_TYPE_FULL => 'F', # full name, optional
|
||||
REC_TYPE_INSP => 'I', # inspector transport
|
||||
REC_TYPE_FILT => 'L', # loop filter transport
|
||||
REC_TYPE_FROM => 'S', # sender, required
|
||||
REC_TYPE_DONE => 'D', # delivered recipient, optional
|
||||
REC_TYPE_RCPT => 'R', # todo recipient, optional
|
||||
REC_TYPE_ORCP => 'O', # original recipient, optional
|
||||
REC_TYPE_WARN => 'W', # warning message time
|
||||
REC_TYPE_ATTR => 'A', # named attribute for extensions
|
||||
|
||||
REC_TYPE_MESG => 'M', # start message records
|
||||
|
||||
REC_TYPE_CONT => 'L', # long data record
|
||||
REC_TYPE_NORM => 'N', # normal data record
|
||||
|
||||
REC_TYPE_XTRA => 'X', # start extracted records
|
||||
|
||||
REC_TYPE_RRTO => 'r', # return-receipt, from headers
|
||||
REC_TYPE_ERTO => 'e', # errors-to, from headers
|
||||
REC_TYPE_PRIO => 'P', # priority
|
||||
REC_TYPE_VERP => 'V', # VERP delimiters
|
||||
|
||||
REC_TYPE_END => 'E', # terminator, required
|
||||
|
||||
);
|
||||
|
||||
}
|
||||
|
||||
sub print_rec {
|
||||
my ($self, $type, @list) = @_;
|
||||
|
||||
die "unknown record type" unless ($rec_types{$type});
|
||||
$self->print($rec_types{$type});
|
||||
|
||||
# the length is a little endian base-128 number where each
|
||||
# byte except the last has the high bit set:
|
||||
my $s = "@list";
|
||||
my $ln = length($s);
|
||||
while ($ln >= 0x80) {
|
||||
my $lnl = $ln & 0x7F;
|
||||
$ln >>= 7;
|
||||
$self->print(chr($lnl | 0x80));
|
||||
}
|
||||
$self->print(chr($ln));
|
||||
|
||||
$self->print($s);
|
||||
}
|
||||
|
||||
sub print_rec_size {
|
||||
my ($self, $content_size, $data_offset, $rcpt_count) = @_;
|
||||
|
||||
my $s = sprintf("%15ld %15ld %15ld", $content_size, $data_offset, $rcpt_count);
|
||||
$self->print_rec('REC_TYPE_SIZE', $s);
|
||||
}
|
||||
|
||||
sub print_rec_time {
|
||||
my ($self, $time) = @_;
|
||||
|
||||
$time = time() unless (defined($time));
|
||||
|
||||
my $s = sprintf("%d", $time);
|
||||
$self->print_rec('REC_TYPE_TIME', $s);
|
||||
}
|
||||
|
||||
sub open_cleanup {
|
||||
my ($class) = @_;
|
||||
my $self = IO::Socket::UNIX->new(Type => SOCK_STREAM,
|
||||
Peer => "/var/spool/postfix/public/cleanup");
|
||||
bless ($self, $class);
|
||||
$self->init();
|
||||
return $self;
|
||||
}
|
||||
|
||||
sub print_attr {
|
||||
my ($self, @kv) = @_;
|
||||
for (@kv) {
|
||||
$self->print("$_\0");
|
||||
}
|
||||
$self->print("\0");
|
||||
}
|
||||
|
||||
sub get_attr {
|
||||
my ($self) = @_;
|
||||
local $/ = "\0";
|
||||
my %kv;
|
||||
for(;;) {
|
||||
my $k = $self->getline;
|
||||
chomp($k);
|
||||
last unless ($k);
|
||||
my $v = $self->getline;
|
||||
chomp($v);
|
||||
$kv{$k} = $v;
|
||||
}
|
||||
return %kv;
|
||||
}
|
||||
|
||||
|
||||
=head2 print_msg_line($line)
|
||||
|
||||
print one line of a message to cleanup.
|
||||
|
||||
This removes any linefeed characters from the end of the line
|
||||
and splits the line across several records if it is longer than
|
||||
1024 chars.
|
||||
|
||||
=cut
|
||||
|
||||
sub print_msg_line {
|
||||
my ($self, $line) = @_;
|
||||
|
||||
$line =~ s/\r?\n$//s;
|
||||
|
||||
# split into 1k chunks.
|
||||
while (length($line) > 1024) {
|
||||
my $s = substr($line, 0, 1024);
|
||||
$line = substr($line, 1024);
|
||||
$self->print_rec('REC_TYPE_CONT', $s);
|
||||
}
|
||||
$self->print_rec('REC_TYPE_NORM', $line);
|
||||
}
|
||||
|
||||
=head2 inject_mail($transaction)
|
||||
|
||||
(class method) inject mail in $transaction into postfix queue via cleanup.
|
||||
$transaction is supposed to be a Qpsmtpd::Transaction object.
|
||||
|
||||
=cut
|
||||
|
||||
sub inject_mail {
|
||||
my ($class, $transaction) = @_;
|
||||
|
||||
my $strm = $class->open_cleanup();
|
||||
|
||||
my %at = $strm->get_attr;
|
||||
my $qid = $at{queue_id};
|
||||
print STDERR "qid=$qid\n";
|
||||
$strm->print_attr('flags' => '0000');
|
||||
$strm->print_rec_time();
|
||||
$strm->print_rec('REC_TYPE_FROM', $transaction->sender->address|| "");
|
||||
for (map { $_->address } $transaction->recipients) {
|
||||
$strm->print_rec('REC_TYPE_RCPT', $_);
|
||||
}
|
||||
# add an empty message length record.
|
||||
# cleanup is supposed to understand that.
|
||||
# see src/pickup/pickup.c
|
||||
$strm->print_rec('REC_TYPE_MESG', "");
|
||||
|
||||
# a received header has already been added in SMTP.pm
|
||||
# so we can just copy the message:
|
||||
|
||||
my $hdr = $transaction->header->as_string;
|
||||
for (split(/\r?\n/, $hdr)) {
|
||||
print STDERR "hdr: $_\n";
|
||||
$strm->print_msg_line($_);
|
||||
}
|
||||
$transaction->body_resetpos;
|
||||
while (my $line = $transaction->body_getline) {
|
||||
# print STDERR "body: $line\n";
|
||||
$strm->print_msg_line($line);
|
||||
}
|
||||
|
||||
# finish it.
|
||||
$strm->print_rec('REC_TYPE_XTRA', "");
|
||||
$strm->print_rec('REC_TYPE_END', "");
|
||||
$strm->flush();
|
||||
%at = $strm->get_attr;
|
||||
my $status = $at{status};
|
||||
my $reason = $at{reason};
|
||||
$strm->close();
|
||||
return wantarray ? ($status, $qid, $reason || "") : $status;
|
||||
}
|
||||
|
||||
1;
|
||||
# vim:sw=2
|
45
plugins/queue/postfix-queue
Normal file
45
plugins/queue/postfix-queue
Normal file
@ -0,0 +1,45 @@
|
||||
=head1 NAME
|
||||
|
||||
postfix-queue
|
||||
|
||||
=head1 DESCRIPTION
|
||||
|
||||
This plugin passes mails on to the postfix cleanup daemon.
|
||||
|
||||
=head1 CONFIG
|
||||
|
||||
It takes one optional parameter, the location of the cleanup socket.
|
||||
|
||||
If set the environment variable POSTFIXQUEUE overrides this setting.
|
||||
|
||||
=cut
|
||||
|
||||
use Qpsmtpd::Postfix;
|
||||
|
||||
sub register {
|
||||
my ($self, $qp, @args) = @_;
|
||||
$self->register_hook("queue", "queue_handler");
|
||||
|
||||
if (@args > 0) {
|
||||
$self->{_queue_socket} = $args[0];
|
||||
$self->log(1, "WARNING: Ignoring additional arguments.") if (@args > 1);
|
||||
} else {
|
||||
$self->{_queue_socket} = "/var/spool/postfix/public/cleanup";
|
||||
}
|
||||
|
||||
$self->{_queue_socket} = $ENV{POSTFIXQUEUE} if $ENV{POSTFIXQUEUE};
|
||||
|
||||
}
|
||||
|
||||
sub queue_handler {
|
||||
my ($self, $transaction) = @_;
|
||||
|
||||
my ($status, $qid, $reason) = Qpsmtpd::Postfix->inject_mail($transaction);
|
||||
$status and return(DECLINED, "Unable to queue message ($status, $reason)");
|
||||
|
||||
my $msg_id = $transaction->header->get('Message-Id') || '';
|
||||
$msg_id =~ s/[\r\n].*//s; # don't allow newlines in the Message-Id here
|
||||
return (OK, "Queued! $msg_id (Queue-Id: $qid)");
|
||||
}
|
||||
|
||||
#vim: sw=2 ts=8
|
Loading…
Reference in New Issue
Block a user