On Wed, 30 Aug 2000, Ricardo Albano wrote:

> Any had implemented qmail-qfilter sucefully or any qmail-queue wrapper ?
> 
> RDA.-
> 

I have a generic qmail-queue-wrapper program. It's written in perl and
in its standard form, does nothing but add another Received header to
the message before calling the real qmail-queue. If you can program in
perl you can get it to do whatever you want. I'm using it to do header
rewrites at one site.

It should be installed with no special permissions

    -rwx--x--x qmailq qmail /var/qmail/bin/qmail-queue

Program is attached.

You can also have a look at Jason Haar's scan4virus program. It too is
a perl qmail-queue-wrapper. Details at www.qmail.org.

-- 
Regards
Peter
----------
Peter Samuel                            [EMAIL PROTECTED]
http://www.e-smith.org (development)    http://www.e-smith.com (corporate)
Phone: +1 613 368 4398                  Fax: +1 613 564 7739
e-smith, inc. 1500-150 Metcalfe St, Ottawa, ON K2P 1P1 Canada

"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;
}

Reply via email to