#!/usr/bin/perl
$ID = q$Id: mjinject,v 1.1 2002/06/29 01:45:48 eagle Exp $;
#
# mjinject -- Inject a message from Majordomo into the qmail queue.
#
# Copyright 1997, 1998, 2002 by Russ Allbery <rra@stanford.edu>
# with help from Giles Lean <giles@nemeton.com.au>
#
# This program is free software; you may redistribute it and/or modify it
# under the same terms as Perl itself.

##############################################################################
# Site configuration
##############################################################################

# The name of the local host, used to qualify addresses.
$hostname = 'example.com';

# VERP is on by default; to turn off, change 1 to 0.
$verp = 1;

# The user-ext character (- by default).  This is the same as conf-break in
# the qmail configuration.
$userext = '-';

# The full path to programs we'll need.
$qmailinject = '/var/qmail/bin/qmail-inject';
$qmailqueue  = '/var/qmail/bin/qmail-queue';

# What directory to use for storing temporary files.
$tempdir = $ENV{TMPDIR} || '/tmp';

##############################################################################
# Modules and declarations
##############################################################################

# We need sysseek(), which wasn't added to core until 5.004.
require 5.004;

use strict;
use vars qw($ID $hostname $qmailinject $qmailqueue $tempdir $userext $verp);

use Fcntl qw(O_CREAT O_EXCL O_RDWR);

##############################################################################
# Error handling
##############################################################################

# Fail with the given message and a permanent failure code.
sub bounce { warn @_, "\n"; exit 100 }

# Fail with the given message and a temporary failure code.
sub tempfail { warn @_, "\n"; exit 111 }

##############################################################################
# qmail-inject handling
##############################################################################

# Takes an incoming message on stdin and passes it through qmail-inject,
# writing it to the given file handle.  Also takes in the address to create a
# Delivered-To line for.
sub inject {
    my ($fh, $address) = @_;

    # We already have the message on stdin, so we don't have to change
    # anything there to feed it to qmail-inject.  We do want to parse the
    # output of qmail-inject since we need to strip off the Return-Path header
    # that it's going to add.
    local $SIG{PIPE} = 'IGNORE';
    my $pid = open (INJECT, '-|');
    if (not defined $pid) {
        tempfail 'Unable to fork. (#4.3.0)';
    } elsif ($pid == 0) {
        # In child.  Exec qmail-inject and let it read the incoming message.
        exec $qmailinject, '-n'
            or tempfail 'Unable to exec qmail-inject. (#4.3.0)';
    } else {
        # In the parent.  Write out a Delivered-To header and then parse the
        # output of qmail-inject, stripping any Return-Path header.
        syswrite ($fh, "Delivered-To: $address\n", 15 + length $address)
            or tempfail 'Unable to write to temporary file. (#4.3.0)';
        local $_;
        my $inheader = 1;
        while (<INJECT>) {
            next if ($inheader && /^Return-Path:/);
            $inheader = 0 if /^$/;
            syswrite ($fh, $_, length $_)
                or tempfail 'Unable to write to temporary file. (#4.3.0)';
        }
        close INJECT;
        if ($? != 0) {
            warn 'Unable to canonify message. (#4.3.0)';
            exit ($? >> 8);
        }
        sysseek ($fh, 0, 0)
            or tempfail 'Unable to rewind temporary file. (#4.3.0)';
    }
}

##############################################################################
# qmail-queue handling
##############################################################################

# Takes in an open file handle for the message, the envelope sender (as a
# string), and the name of the file that contains the list of addresses to
# send the message to.
sub queue {
    my ($message, $sender, $addresses) = @_;

    # Create a pipe through which to send the envelope addresses.
    pipe (EOUT, EIN) or tempfail 'Unable to create a pipe. (#4.3.0)';

    # Fork qmail-queue.  The qmail-queue child will then open fd 0 as $message
    # and fd 1 as the reading end of the envelope pipe and exec qmail-queue.
    # The parent will read in the addresses from the file one at a time and
    # pass them through the pipe and then check the exit status.
    local $SIG{PIPE} = 'IGNORE';
    my $pid = fork;
    if (not defined $pid) {
        tempfail 'Unable to fork. (#4.3.0)';
    } elsif ($pid == 0) {
        # In child.  Mutilate our file handles.
        close EIN;
        open (STDIN, "<&$$message")
            or tempfail 'Unable to reopen fd 0. (#4.3.0)';
        open (STDOUT, "<&EOUT")
            or tempfail 'Unable to reopen fd 1. (#4.3.0)';
        exec $qmailqueue
            or tempfail 'Unable to fork qmail-queue. (#4.3.0)';
    } else {
        # In parent.
        close EOUT;
        my ($user, $host);

        # Figure out the envelope sender and do the VERP magic if desired.
        if ($sender =~ /\@/) {
            ($user, $host) = split (/\@/, $sender);
        } else {
            $user = $sender;
            $host = $hostname;
        }
        if ($verp) { $user .= $userext unless $user =~ /$userext$/o }
        $sender = "$user\@$host";
        $sender .= "$userext\@[]" if $verp;

        # Feed the envelope addresses to qmail-queue.
        print EIN "F$sender\0";
        open (ADDRESSES, $addresses)
            or tempfail 'Unable to open address file. (#4.3.0)';
        local $_;
        while (<ADDRESSES>) {
            my ($address) = split;
            $address .= "\@$hostname" if (!/\@/);
            print EIN "T$address\0";
        }
        close ADDRESSES;
        print EIN "\0";
        close EIN
            or tempfail 'Write error to envelope pipe. (#4.3.0)';
    }

    # We should now have queued the message.  Let's find out the exit status
    # of qmail-queue.
    waitpid ($pid, 0);
    if ($? != 0) { tempfail 'Unable to queue message. (#4.3.0)' }
}

##############################################################################
# Program invocation
##############################################################################

# Given the message on a file handle followed by the command to run (as a
# list), rewind the file handle and pass the message in to the command.  If we
# encounter any errors, we bounce the message (we don't want to fail
# temporarily, since we've already successfully delivered to the main list).
sub feed {
    my ($message, @command) = @_;

    # Rewind the temporary file, since the previous operation left it at the
    # end of the file.
    sysseek ($message, 0, 0)
        or bounce 'Unable to rewind temporary file. (#5.3.0)';

    # Fork off a child.  The child will then reopen STDIN to be the message
    # and exec the program.
    local $SIG{PIPE} = 'IGNORE';
    my $pid = fork;
    if (not defined $pid) {
        bounce 'Unable to fork. (#5.3.0)';
    } elsif ($pid == 0) {
        # In child.  Mutilate our file handles.
        open (STDIN, "<&$$message")
            or bounce 'Unable to reopen fd 0. (#5.3.0)';
        exec @command
            or bounce "Unable to fork $command[0]. (#5.3.0)";
    }

    # Now, wait for our child and make sure that it succeeded.
    waitpid ($pid, 0);
    if ($? != 0) { bounce "$command[0] failed. (#5.3.0)" }
}

##############################################################################
# Main routine
##############################################################################

# We take -r to force VERP to be on and -R to force VERP to be off; if neither
# flag is present, we default to whatever $verp is set to at the top of this
# file.
if ($ARGV[0] =~ /^-/) {
    my $option = shift;
    if ($option !~ /^-[rR]+$/) {
        bounce "Invalid option '$option'. (#5.2.4)";
    } elsif ($option =~ /r/ && $option =~ /R/) {
        bounce 'Only one of -r and -R may be specified. (#5.2.4)';
    }
    $verp = ($option =~ /r/);
}

# We take two non-optional arguments, the file of addresses to send the
# message to and the envelope sender that we should use.  We take the message
# to be injected on stdin.  The filename portion of the address file path is
# also taken to be the local e-mail address for the purposes of constructing a
# Delivered-To header.  (This is a bit of a hack, but it works for the default
# majordomo setup.)
my ($addresses, $sender) = @ARGV;
unless ($sender) { bounce 'Syntax error, sender not given. (#5.2.4)' }
unless (-r $addresses) { bounce 'Address file not found. (#5.2.4)' }
my ($address) = ($addresses =~ m%/([^/]+)$%);
$address .= "\@$hostname";

# Open a temporary file that we'll store the message in.
sysopen (TMP, "$tempdir/mjinject.$$", O_CREAT | O_EXCL | O_RDWR)
    or tempfail 'Unable to create temporary file. (#4.3.0)';
unlink "$tempdir/mjinject.$$"
    or tempfail 'Unable to unlink temporary file. (#4.3.0)';

# Read in the message and run it through qmail-inject.
inject (\*TMP, $address);

# Queue the message.
queue (\*TMP, $sender, $addresses);

# If we need to send the message through archive or digest, do that.
if (-r "$addresses.programs") {
    open (PROGRAMS, "$addresses.programs")
        or bounce 'Unable to open programs file. (#5.2.4)';
    while (<PROGRAMS>) {
        my @command = split;
        next unless @command;
        feed (\*TMP, @command);
    }
    close PROGRAMS;
}

# Success.
close TMP;
exit 0;

##############################################################################
# Documentation
##############################################################################

=head1 NAME

mjinject - Inject a message from Majordomo into the qmail queue

=head1 SYNOPSIS

B<mjinject> [B<-rR>] I<address-file> I<sender> < I<message>

=head1 DESCRIPTION

This program is intended to be used as the outgoing mailer for Majordomo's
resend program on a system using qmail.  It takes a file of addresses and a
sender address on the command line and an e-mail message on stdin and passes
the message along to qmail-queue after running it through qmail-inject to
canonify addresses and the like.  In the address file, everything after the
first space on a line is ignored, so the addresses can include comments
provided that the address is the first sequence of non-whitespace on each
line.  Whitespace in addresses is not supported.

If the file name created by appending C<.programs> to the address file
exists, then in addition to passing the message to qmail-inject, mjinject
also runs each program listed in that file and passes the message to it.
The syntax is one program command line per line of the file, with whitespace
separating the arguments (whitespace in arguments is not supported).

To use this program as Majordomo's outgoing mailer, just change the $mailer
line in F<majordomo.cf> to:

    $mailer = "/var/qmail/majordomo/mjinject $listdir/$opt_l \$sender";

(replacing /var/qmail/majordomo/mjinject with the full path to this script).
Any arguments passed by resend to this program are ignored when using the
above syntax, so there's no need to do anything special with the resend
invocation.

The address list used will be the address list of the mailing list,
maintained by Majordomo, so make sure that that address list consists of
addresses, one per line, optionally with additional information after the
address separated by a space.

When using this program, be sure to edit the beginning of it and change the
hostname setting to point to your local host.  B<mjinject> uses this to
fully-qualify addresses.

=head1 OPTIONS

=over 4

=item B<-r>

Force VERP (per-message sender addresses containing the e-mail address of
the recipient, to enable cleaner bounce handling) to be used.  For more
information on VERP, see L<http://cr.yp.to/proto/verp.txt>.

=item B<-R>

Force VERP not to be used.

=back

Without a command-line flag, the VERP default is determined by the setting
of $verp at the top of the program (normally on).

=head1 RETURN VALUE

For nearly all errors, B<mjinject> exits 111 to tell qmail to defer the the
message and try to deliver it again.  However, if an error is encountered
when feeding the message to a program (using a C<.programs> file), the
message is bounced instead because it has already been delivered to the
subscribers.

=head1 SEE ALSO

qmail-inject(8), qmail-queue(8)

For information about qmail, see L<http://cr.yp.to/qmail.html>.

For detailed information on how to install and use this program, see the
Majordomo with qmail FAQ at
L<http://www.eyrie.org/~eagle/faqs/mjqmail.html>.

Current versions of this program are available from its web site at
L<http://www.eyrie.org/~eagle/software/mjqmail/>.

=head1 AUTHOR

Russ Allbery <rra@stanford.edu> with help from Giles Lean
<giles@nemeton.com.au>

=head1 COPYRIGHT AND LICENSE

Copyright 1997, 1998, 2002 by Russ Allbery <rra@stanford.edu>.

This program is free software; you may redistribute it and/or modify it
under the same terms as Perl itself.

=cut