Hello everyone,
considering what I wrote in my last mails, I have now written my own
experimental queue plugin for postfix which will drop the mail into
the postdrop-Spool and then notify the pickup daemon.
With this plugin the queuing of a 10 MB mail will now only take
three seconds. The processing afterwards (by the pickup daemon)
will still take two minutes, but at least the SMTP client is no
longer stalled and might run into an error.
This plugin currently duplicated some of the functions out of
Qpsmtpd::Postfix. It might make sense to add this as an alternative
inject method to that class.
My plugin is attached. I don't make any promised but it works for
me. Testing by others and feedback would be very much appreciated.
Regards
Michael
--
It's an insane world, but i'm proud to be a part of it. -- Bill Hicks
#!/usr/bin/perl
=head1 NAME
postfix-maildrop
=head1 DESCRIPTION
This plugin places a mail in the postfix maildrop directory and then
notifies the postfix pickup daemon.
The advantage of this approach over the postfix-queue plugin which
submits the message to the cleanup daemon is that this plugin does
not have to wait for an answer from postfix (which can take a long
time for large mails submitted to the cleanup daemon) and will even
work when postfix is not running.
=head1 CONFIG
This plugin accepts two optional parameters.
The first parameter is the path to the maildrop directory. It
will default to '/var/spool/postfix/maildrop'.
The second parameter is the path to the pipe of the pickup
daemon. It will default to '/var/spool/postfix/public/pickup'.
Please note that the user qpsmtpd is running under MUST be a
member of the postdrop group.
=cut
use File::Temp qw(tempfile);
use File::Basename qw(basename);
use Fcntl;
sub register {
my ($self, $qp, @args) = @_;
$self->{_maildrop_dir} = "/var/spool/postfix/maildrop";
if ( @args >= 1 && $args[0] =~ m#^(/.+)# ) {
# untaint maildrop path
$self->{_maildrop_dir} = $1;
}
$self->{_pickup_pipe} = "/var/spool/postfix/public/pickup";
if ( @args >= 2 && $args[1] =~ m#^(/.+)# ) {
# untaint pickup pipe path
$self->{_pickup_pipe} = $1;
}
}
sub hook_queue {
my ($self, $transaction) = @_;
# Create a new file in the maildrop queue
# which is only readable by us so that the pickup daemon
# will not read it (for now)
my $oldumask = umask(oct(177)) or
return(DECLINED, "postfix-maildrop: Error at umask");
my ( $fh, $filename) = tempfile(
DIR => $self->{_maildrop_dir}) or
return(DENY, "postfix-maildrop: Can't create temporary file");
# Now for the data
print_rec_time($fh);
print_rec($fh, 'REC_TYPE_ATTR', 'rewrite_context=local');
print_rec($fh, 'REC_TYPE_FROM',
strip_email_brackets($transaction->sender->address||''));
foreach my $rcpt ( $transaction->recipients ) {
print_rec($fh, 'REC_TYPE_RCPT', strip_email_brackets($rcpt));
}
print_rec($fh, 'REC_TYPE_MESG', '');
my $hdr = $transaction->header->as_string;
for (split(/\r?\n/, $hdr)) {
print_msg_line($fh, $_);
}
$transaction->body_resetpos;
while (my $line = $transaction->body_getline) {
print_msg_line($fh, $line);
}
print_rec($fh, 'REC_TYPE_XTRA', '');
print_rec($fh, 'REC_TYPE_END', '');
# That's it. Close the file and then change the permissions
# so that the pickup daemon can read it
close($fh);
chmod(oct(744),$filename) or
return(DECLINED, "postfix-maildrop: Can't chmod mailfile");
# Now notify the pickup daemon. Timeout after one second,
# no error handling. It does not matter: We have written the
# mail to the maildrop and it will get processed eventually
# anyway.
my $oldalrm = $SIG{'ALRM'};
$SIG{'ALRM'} = sub {};
eval {
alarm(1);
open(my $pipe, '>', $self->{_pickup_pipe});
print $pipe "W";
close($pipe);
alarm(0);
$SIG{'ALRM'} = $oldalrm;
};
$SIG{'ALRM'} = $oldalrm;
return (OK, "Queued! (" . basename($filename) . ")");
}
# ---
sub strip_email_brackets {
my ($email) = @_;
$email =~ s/^<//;
$email =~ s/>$//;
return $email;
}
sub print_rec {
my ($fh, $type, @list) = @_;
my %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
);
die "unknown record type $type" unless ($rec_types{$type});
print $fh $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;
print $fh chr($lnl | 0x80);
}
print $fh chr($ln);
print $fh $s;
}
sub print_rec_time {
my ($fh, $time) = @_;
$time = time() unless (defined($time));
my $s = sprintf("%d", $time);
print_rec($fh, 'REC_TYPE_TIME', $s);
}
sub print_msg_line {
my ($fh, $line) = @_;
$line =~ s/\r?\n$//s;
# split into 1k chunks.
while (length($line) > 1024) {
my $s = substr($line, 0, 1024);
$line = substr($line, 1024);
print_rec($fh, 'REC_TYPE_CONT', $s);
}
print_rec($fh, 'REC_TYPE_NORM', $line);
}
