Ok, this is the last one for today, I promise :-) A plugin to inject mails into the postfix queue via the cleanup daemon.
The class Qpsmtp::Postfix is a partial implementation of the protocol
the postfix daemons use to talk to each other. Since that is only
documented by source, it may not work with all postscript versions (I'm
using 1.1.12).
hp
--
_ | Peter J. Holzer | We have failed our own creation and given
|_|_) | Sysadmin WSR | birth something truly awful. We're just too
| | | [EMAIL PROTECTED] | busy cooing over the pram to notice.
__/ | http://www.hjp.at/ | -- http://www.internetisshit.org
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
=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
pgp00000.pgp
Description: PGP signature
