#!/usr/bin/perl
# Copyright 2007, Michael Allan.  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Votorola Software"), to deal in the Votorola Software without restriction, including without limitation the rights to use, copy, modify, merge, publish, distribute, sublicence, and/or sell copies of the Votorola Software, and to permit persons to whom the Votorola Software is furnished to do so, subject to the following conditions: The preceding copyright notice and this permission notice shall be included in all copies or substantial portions of the Votorola Software. THE VOTOROLA SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE VOTOROLA SOFTWARE OR THE USE OR OTHER DEALINGS IN THE VOTOROLA SOFTWARE.
use strict; use warnings;
=pod

=head1 NAME

tmda-filter-wrapper - preprocess messages before TMDA filtering

=head1 SYNOPSIS

tmda-filter-wrapper I<path>/tmda-filter [I<arguments>]

=head1 DESCRIPTION

Wrapper tmda-filter-wrapper is part of the authentication layer
of the mail-based voter interface. It reads the message from standard input,
adjusts the environment variable SENDER (envelope sender address) if necessary,
and passes the message on to tmda-filter (TMDA).
TMDA will then challenge the envelope sender address as usual.

This wrapper adjusts SENDER by setting it to the
first 'From' or 'Sender' (message sender) address.
It thus alters the envelope sender to match the message sender.

An exception is made for an empty envelope SENDER. It is left empty.
It indicates a bounce, and TMDA does not attempt to verify bounces
(in order to avoid loops).

After altering the SENDER variable (maybe), the remainder of the command line
(the call to TMDA) is executed as a separate process,
and the message is fed to it on standard input.

=head2 Rationale

Votorola needs an authenticated email identity for the human sender.
The authentication challenge must therefore be done on the message address
as opposed to the envelope address. The envelope address is only intended
as a return path for delivery failures and such (RFC 2821).

For example, the sender may be using TMDA too, and may be date-tagging
the envelope address.  So the envelope address would vary
from message to message, making it unsuitable as a sender identifier.

As well, the envelope address is not directly under the sender's control.
It is part of the delivery mechanism, outside of the encoded message,
and may become altered in the normal course of mail transfer.
So again, would be unsuitable as a sender identifier.

=cut

{
    use Email::Address ();
    use Email::Simple ();
    use Pod::Usage qw( pod2usage );

    scalar @ARGV or pod2usage( -verbose => 1 ); # and exits

   # If envelope sender is empty (a bounce), let TMDA handle it as usual.
   # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    $ENV{'SENDER'} or exec @ARGV; # and exits

   # Read message from standard input, and set envelope sender to message sender.
   # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    my $message = Email::Simple->new( join '', <STDIN> );

    my $message_sender_address = ''; # till proven otherwise
    my @address_spec = Email::Address->parse( $message->header( 'From' ));
    if( scalar @address_spec )
    {
        $message_sender_address = $address_spec[0]->address;
    }
    else
    {
        @address_spec = Email::Address->parse( $message->header( 'Sender' )); # should always be true by this point, I suppose, per RFC 822
        if( scalar @address_spec )
        {
            $message_sender_address = $address_spec[0]->address;
        }
    }

    if( $message_sender_address && $message_sender_address ne $ENV{'SENDER'} )
    {
        $ENV{'SENDER'} = $message_sender_address;
        my $return_path = $message->header( 'Return-Path' ); # preline call in .qmail adds this, to match SENDER
        if( $return_path )  # change it as well, to be consistent; and because the mail interface reads the verifyed address from this header
        {
            $message->header_set( 'X-Return-Path-Was', $return_path ); # in case anyone wonders what it used to be (could revert it, when the message passes through again after TMDA confirmation, but that might confuse TMDA)
            $message->header_set( 'Return-Path', "<$message_sender_address>" );
        }
    }
    # else leave it, and let TMDA verify it as is

   # Execute tmda-filter command, and pipe it the message.
   # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    my $command_process = open( COMMAND, '|-', @ARGV ) or die "fork failure: $!";
    {
        local $SIG{PIPE} = sub { die 'pipe broke' }; # defines error handler for writes

        print COMMAND $message->as_string() or die "print failure: $!";
      # close COMMAND or die "close failure: $!";
      ### close considers a non-zero exit value (expected from tmda-filter) as a failure, so:
        close COMMAND or ($! and die "close failure: $!"); # blocks till command process finishes
    }
    my $command_exit = $?;

   # Exit.
   # - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
    my $qmail_soft_error = 111; # Try again later, per qmail-local and qmail-command. (Hard error is 100.) A plain 'die' (as above) seems also to be treated as a soft error, and their error messages end up in the qmail logs.
    $command_exit == -1 and exit $qmail_soft_error; # failed to execute, reason unknown

    my $command_exit_signal = $command_exit & 0x7f;
    $command_exit_signal and exit $qmail_soft_error; # terminated by signal

    my $command_exit_value = $command_exit >> 8;
    exit $command_exit_value;
}


=pod

=head1 CAVEATS

Only tested with qmail.  It should work with any mail transfer agent (MTA),
but you might have to modify it slightly.  Pay particular attention
to the environment variable SENDER which it expects from the MTA.

=cut