This is Peter Samuel’s script, adapted to prepend a X-AuthUser header for mail sent via mailchannels.com

qmail-queue-wrapper.pl

#!/usr/bin/perl -w
#
# $Id: qmail-queue-wrapper.pl,v 1.3 2007/03/06 14:55:09 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
#
# The default version of this program assumes option (2) above.
#
# 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.
#
###########################################################################

use strict;

my $child;
my $debug = 0;
my $envelope;
my %errors;
my $qmailqueue = "/var/qmail/bin/qmail-queue.orig";
my @recipients;
my $sender;
my $tcpremoteinfo;
$ENV{"PATH"} = "/usr/bin";


###########################################################################

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();
    waitpid $child, 0;          # Wait for the child to terminate
    exit $? % 255;          # Return with the exit status of child
}
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
    {
        fatal(82) unless exec $qmailqueue;
    }
}
else
{
    fatal(82);              # Unable to fork
}

###########################################################################

sub initialise
{
    prepare_error_messages();
    ignore_signals();
    catch_signals();
    setup_pipes();
}

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'} = sub { fatal(52); };
    $SIG{'ILL'}  = sub { fatal(81); };
    $SIG{'ABRT'} = sub { fatal(81); };
    $SIG{'FPE'}  = sub { fatal(81); };
    $SIG{'BUS'}  = sub { fatal(81); };
    $SIG{'SEGV'} = sub { fatal(81); };
    $SIG{'SYS'}  = sub { fatal(81); } if (defined $SIG{'SYS'});
    $SIG{'EMT'}  = sub { fatal(81); } if (defined $SIG{'EMT'});
}

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
{
    print STDERR shift;
}

sub fatal
{
    my $errno = shift;
    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!

    if (defined $ENV{'TCPREMOTEINFO'} && $ENV{'TCPREMOTEINFO'} ne '') {
        $tcpremoteinfo = $ENV{'TCPREMOTEINFO'};
        print MESSAGE_WRITER "X-AuthUser: $ENV{'TCPREMOTEINFO'}\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 but
    # you need to explicitly specify the file descriptor number
    # rather than the filehandle (Older versions of Perl 5 allowed
    # you to specify the filehandle).

    # Duplicate file descriptor 1 for reading.

    fatal(54) unless defined open DUP_STDOUT, "<&1";

    # Temporarily disable Perl warnings - Perl complains with
    #
    #    Filehandle DUP_STDOUT opened only for output at thisfile line 349.
    #
    # which is annoying and not a problem (at least with my testing).
    # So we'll temporarily disable it while we deal with DUP_STDOUT.

    $^W = 0;

    # Extract the envelope details. The stripping of the leading 'F'
    # and 'T' characters will be performed later.

    $envelope = <DUP_STDOUT>;
    $^W = 1;                # Re-enable Perl warnings
}

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
{
    fatal(54) unless close DUP_STDOUT;  # Close duplicated STDOUT
}