On Wed, 31 May 2000, Peter Samuel wrote:
>
> I too have a simple Pierl qmail-queue wrapper. Let me tidy it up and
> I'll post it to the list. It currently does nothing, but can be used
> to do whatever wrapping you feel is appropriate (provided you can
> write the code to do it).
I have attached qmail-queue-wrapper.pl. It is a generic qmail-queue
wrapper. It currently does nothing to a message except add an extra
header of the form
Received: (qmail-queue-wrapper 24590 invoked from network);
31 May 2000 07:16:44 -0000
It then simply hands the message over to the real qmail-queue.
If you know perl, you can modify it to do whatever you want - just
don't come crying to me if it doesn't work after you've modified it.
To install:
install perl if you haven't got it on your system
choose a non production system to test this on
choose a quiet time
save the perl file in /var/qmail/bin/qmail-queue-wrapper.pl
stop qmail-smtpd
stop qmail-qmqpd
stop qmail
cd /var/qmail/bin
vi qmail-queue-wrapper.pl
change the first line
#!/pkgs/bin/perl -w
to reflect where your perl binary really lives
chown root qmail-queue-wrapper.pl
chgrp qmail qmail-queue-wrapper.pl
chmod 755 /tmp/qmail-queue-wrapper.pl
# The wrapper program should NOT be setuid!!!
mv qmail-queue qmail-queue.orig; mv qmail-queue-wrapper.pl qmail-queue
start qmail
start qmail-qmqpd
start qmail-smtpd
There is a small chance that mail injected into the queue via
qmail-inject (and it's friends sendmail and datemail) will attempt to
call qmail-queue between the "mv" commands above. That's
why you should choose a quiet time.
Regards
Peter
----------
Peter Samuel [EMAIL PROTECTED]
Technical Consultant or at present:
eServ. Pty Ltd [EMAIL PROTECTED]
Phone: +61 2 9206 3410 Fax: +61 2 9281 1301
"If you kill all your unhappy customers, you'll only have happy ones left"
#!/pkgs/bin/perl -w
#
# $Id: qmail-queue-wrapper.pl,v 1.1 2000/05/31 07:20:37 psamuel Exp $
#
# qmail-queue wrapper program.
#
# This program should be used when you wish to manipulate a mail
# message BEFORE it is placed in the queue. Possible uses include:
#
# - header rewriting
# - Firstname.Lastname replacements
# - virus scanning
# - anything else you can think of
#
# There are at least 2 ways of using this program:
#
# 1) Replace the original qmail-queue with this program:
#
# mv /var/qmail/bin/qmail-queue /var/qmail/bin/qmail-queue.orig
# cp qmail-queue-wrapper /var/qmail/bin/qmail-queue
#
# Change the value of $qmailqueue below, to reflect the new name of
# the original qmail-queue program. For example
#
# my $qmailqueue = "/var/qmail/bin/qmail-queue.orig";
#
# 2) Recompile qmail with Bruce Guenter's QMAILQUEUE patch. (See
# http://www.qmail.org/qmailqueue-patch). Then any program that
# needs to use this program can be called with the environment
# variable QMAILQUEUE set to /var/qmail/bin/qmail-queue-wrapper
#
# How does it work? The interface to the real qmail-queue is simple:
#
# - the body of the message is read from file descriptor 0
# - the envelope details are read from file descriptor 1.
#
# qmail-queue-wrapper also adheres to the same interface. After doing
# whatever manipulations are necessary, it calls the real qmail-queue
# and provides the message body on file descriptor 0 and the envelope
# details on file descriptor 1.
#
# Exit codes conform to those mentioned in the qmail-queue(8) manual page.
#
###########################################################################
require 5;
use strict;
my $child;
my $debug = 0;
my $envelope;
my %errors;
my @months;
my $new_received_header;
my $qmailqueue = "/var/qmail/bin/qmail-queue.orig";
my @recipients;
my $sender;
###########################################################################
&initialise();
if ($child = fork())
{
# Parent
my $timeout = 86400; # See qmail-queue.c, line 20
alarm($timeout);
&fatal(82) unless close MESSAGE_READER;
&fatal(82) unless close ENVELOPE_READER;
&process_message();
&process_envelope();
# Wait for the child to terminate
waitpid($child, 0);
# Return with the exit status of the child
exit($? % 255);
}
elsif (defined $child)
{
# Child
&fatal(82) unless close MESSAGE_WRITER;
&fatal(82) unless close ENVELOPE_WRITER;
&fatal(82) unless defined open(STDIN, "<&MESSAGE_READER");
&fatal(82) unless defined open(STDOUT, "<&ENVELOPE_READER");
if ($debug)
{
&debug_message("$$: Reading message from STDIN\n\n");
while (<STDIN>)
{
&debug_message("$$: $_");
}
&fatal(82) unless close MESSAGE_READER;
&debug_message("\n$$: ####################\n\n");
&debug_message("$$: Reading envelope from STDOUT\n");
while (<ENVELOPE_READER>)
{
s/\0/ /g;
&debug_message("$$: $_\n");
}
&fatal(82) unless close ENVELOPE_READER;
exit(0);
}
else
{
unless (exec $qmailqueue)
{
# We shouldn't be here unless the exec failed
&fatal(82);
}
}
}
else
{
# Unable to fork
&fatal(82);
}
###########################################################################
sub initialise
{
&prepare_months();
&prepare_error_messages();
&ignore_signals();
&catch_signals();
&generate_new_received_header();
&setup_pipes();
}
sub prepare_months
{
@months = (
"Jan", "Feb", "Mar", "Apr",
"May", "Jun", "Jul", "Aug",
"Sep", "Oct", "Nov", "Dec",
);
}
sub prepare_error_messages
{
# These are the exit codes and their meanings, as defined by the
# real qmail-queue manual page. Many are not used by either the
# real qmail-queue or this wrapper program.
%errors = (
11 => "Address too long",
31 => "Mail server permanently refuses to send " .
"the message to any recipients",
# Not used by qmail-queue, but can be used by
# programs offering the same interface
51 => "Out of memory",
52 => "Timeout",
53 => "Write error; e.g., disk full",
54 => "Unable to read the message or envelope",
55 => "Unable to read a configuration file",
# Not used by qmail-queue
56 => "Problem making a network connection from this host",
# Not used by qmail-queue
61 => "Problem with the qmail home directory",
62 => "Problem with the queue directory",
63 => "Problem with queue/pid",
64 => "Problem with queue/mess",
65 => "Problem with queue/intd",
66 => "Problem with queue/todo",
71 => "Mail server temporarily refuses to send " .
"the message to any recipients",
# Not used by qmail-queue
72 => "Connection to mail server timed out",
# Not used by qmail-queue
73 => "Connection to mail server rejected",
# Not used by qmail-queue
74 => "Connection to mail server succeeded, but " .
"communication failed",
# Not used by qmail-queue
81 => "Internal bug; e.g., segmentation fault",
82 => "System resource problem",
# Undefined in qmail-queue. Specific to this
# wrapper program.
91 => "Envelope format error",
);
}
sub ignore_signals
{
# The real qmail-queue ignores a bunch of signals, so we will too.
# Ensure all signals are not being blocked.
foreach (keys %SIG)
{
$SIG{$_} = 'DEFAULT';
}
# Ignore those signals that the real qmail-queue ignores.
$SIG{'PIPE'} = 'IGNORE';
$SIG{'VTALRM'} = 'IGNORE';
$SIG{'PROF'} = 'IGNORE';
$SIG{'QUIT'} = 'IGNORE';
$SIG{'INT'} = 'IGNORE';
$SIG{'HUP'} = 'IGNORE';
$SIG{'XCPU'} = 'IGNORE' if (defined $SIG{'XCPU'});
$SIG{'XFSZ'} = 'IGNORE' if (defined $SIG{'XFSZ'});
}
sub catch_signals
{
# The real qmail-queue catches a few signals, so we will too.
$SIG{'ALRM'} = \&timeout;
$SIG{'ILL'} = \&internal_bug;
$SIG{'ABRT'} = \&internal_bug;
$SIG{'FPE'} = \&internal_bug;
$SIG{'BUS'} = \&internal_bug;
$SIG{'SEGV'} = \&internal_bug;
$SIG{'SYS'} = \&internal_bug if (defined $SIG{'SYS'});
$SIG{'EMT'} = \&internal_bug if (defined $SIG{'EMT'});
}
sub timeout
{
&fatal(52);
}
sub internal_bug
{
&fatal(81);
}
sub generate_new_received_header
{
# Generate a Received: header of the form:
# Received: (qmail 28672 invoked by alias); 16 Feb 2000 03:49:51 -0000
my @user = getpwuid($<);
my @date = gmtime();
my $user;
if ($user[0] eq "alias")
{
$user = "by alias";
}
elsif ($user[0] eq "qmaild")
{
$user = "from network";
}
elsif ($user[0] eq "qmails")
{
$user = "for bounce";
}
elsif (scalar @user == 0)
{
# This should never happen - ie the real user id should
# always have a password entry.
$user = "by uid $<";
}
else
{
$user = "by uid $user[2]";
}
$date[5] += 1900;
my $date = "$date[3] $months[$date[4]] $date[5]";
my $time = sprintf("%02d:%02d:%02d", $date[2], $date[1], $date[0]);
$new_received_header =
"Received: (qmail-queue-wrapper $$ invoked $user); $date $time -0000";
}
sub setup_pipes
{
&fatal(82) unless pipe(MESSAGE_READER, MESSAGE_WRITER);
&fatal(82) unless pipe(ENVELOPE_READER, ENVELOPE_WRITER);
select(MESSAGE_WRITER); $| = 1;
select(ENVELOPE_WRITER); $| = 1;
}
sub debug_message
{
my ($message) = @_;
print STDERR "$message";
}
sub fatal
{
my ($errno) = @_;
&debug_message("$errors{$errno}\n") if $debug;
exit($errno);
}
sub process_message
{
# If you plan on doing serious massaging of the message body, such
# as virus scanning or MIME conversions, you should probably write
# the message to a temporary file here. Once you have finished your
# massaging you can read from the file. You could slurp the message
# into memory but that may be a resource problem for you. Caveat
# emptor!
print MESSAGE_WRITER "$new_received_header\n";
while (<STDIN>)
{
print MESSAGE_WRITER;
}
&fatal(82) unless close MESSAGE_WRITER;
}
sub process_envelope
{
&read_envelope();
# If you don't want to do any rigourous checking of the envelope,
# simply comment out the &check_envelope() statement. The real
# qmail-queue will perform the same checks anyway.
&check_envelope();
&close_envelope();
print ENVELOPE_WRITER "$envelope";
&fatal(82) unless close ENVELOPE_WRITER;
}
sub read_envelope
{
# Read the message envelope from file descriptor 1. At startup this is
# already assigned to the Perl filehandle STDOUT.
# Duplicate file descriptor 1 for reading
&fatal(54) unless defined open(DUP_STDOUT, "<&STDOUT");
# Extract the envelope details. The stripping of the leading 'F'
# and 'T' characters will be performed later.
$envelope = <DUP_STDOUT>;
}
sub check_envelope
{
# There MUST be some envelope details.
&fatal(54) unless defined $envelope;
# The envelope details MUST be terminated by two NULLS.
&fatal(54) if ($envelope !~ /\0\0$/);
($sender, @recipients) = split(/\0/, $envelope);
# If there are no recipients, we should exit here. However, the
# real qmail-queue will quite happily accept messages with no
# recipients, so we will too.
# The sender address MUST begin with an 'F' and the recipient
# address(es) MUST begin with a 'T'.
&fatal(91) if ($sender !~ /^F/);
foreach (@recipients)
{
&fatal(91) if ($_ !~ /^T/);
}
# None of the addresses may be greater than $address_length
# characters. (Remember that each address has an extra leading
# character at this stage, so it's just a "greater than" test,
# rather than a "greater than or equal to" test).
my $address_length = 1003; # See qmail-queue.c, line 21
foreach ($sender, @recipients)
{
&fatal(11) if (length($_) > $address_length);
}
# The sender AND recipient address(es) should contain a username,
# an @ sign and a fully qualified domain name. However, the real
# qmail-queue does not enforce this, so we won't either.
}
sub close_envelope
{
# Close duplicated STDOUT
&fatal(54) unless close DUP_STDOUT;
}
