#! /usr/bin/perl
# © Heiko Schlittermann
use constant USAGE => << '#'; 
!ME! [options] [-- exim native options] 

    --[no]log	show the log output	[!$Cf->log!]
    --[no]debug	show debug output	[!$Cf->debug!]

    --from=s	from:			[!$Cf->from!]
    --to=s	to:			[!$Cf->to!]
		(comma separated)

    --Helo=s	HELO	   		[!$Cf->Helo!]
    --From=s	MAIL FROM:		[!$Cf->From!]
    --To=s	RCPT TO: 		[!$Cf->To!]
                (comma separated)

    --src=s	src ip/name		[!$Cf->src!]
    --dst=s	dst ip/name		[!$Cf->dst!]

    --au	user (-oMai)		[!$Cf->oMai!]
    --aa	authenticator (-oMaa)	[!$Cf->oMaa!]
    
    --exim=s	exim binary		[!$Cf->exim!]
    --config=s	exim config file	[!$Cf->config!]

    --[no]callout			[!$Cf->callout!]

    Environment used: $EXIM		[!$ENV{EXIM}!]
                      $EXIM_CONF	[!$ENV{EXIM_CONF}!]

    mail data is read from STDIN unless it's connected to terminal.

    Source: https://keller.schlittermann.de/hg/exiacl

#

use strict;
use warnings;
use AppConfig;
use IPC::Open3;
use IO::Select;
use Socket;
use File::Basename;

our $VERSION = "1.2";

sub exim_option($);
sub read_exim($;$);
sub write_exim($@);
sub addr(@);
sub hostname() { chomp (my $h = `hostname -f`); return $h;  }

sub which($) { (map { -x "$_/$_[0]" && "$_/$_[0]" || () } split /:/, $ENV{PATH})[0] }
sub findExim() { $ENV{EXIM} || which("exim") || which("exim4") || undef }
sub guessConfig() { $_ = findExim(); qx/$_ "-bV"/ =~ /^Configuration.*\sis\s+(\S+)/mi and return $1 }

use constant ME => basename $0;
use constant HOSTNAME => hostname;

my $Cf = new AppConfig (
    { CASE => 1 },

    log	    => { ARGS => "!",  DEFAULT => 1 },
    debug   => { ARGS => "!",  DEFAULT => 0 },

    from    => { ARGS => "=s" },
    to	    => { ARGS => "=s" },

    Helo    => { ARGS => "=s", ALIAS => "ehlo" },
    From    => { ARGS => "=s" },
    To	    => { ARGS => "=s" },

    src	    => { ARGS => "=s", DEFAULT => "172.20.1.8"  },
    dst	    => { ARGS => "=s"  },		    # exim primary_hostname

    au	    => { ARGS => "=s" },
    aa	    => { ARGS => "=s" },

    exim    => { ARGS => "=s", DEFAULT => findExim() },
    config  => { ARGS => "=s", DEFAULT => guessConfig(), ALIAS => "C" },

    callout =>	{ ARGS => "!", DEFAULT => 1 },
    help    =>	{ ARGS => "!" },

) or die;

    $Cf->exim				    or die "No exim binary found\n";
    $Cf->dst(addr(exim_option("primary_hostname")));
    #$Cf->getopt(qw(pass_through no_ignore_case)) or die $@;
    $Cf->getopt(qw(no_ignore_case)) or die $@;

    $Cf->From($Cf->from)		    unless $Cf->From;
    $Cf->To($Cf->to)			    unless $Cf->To;

    $Cf->Helo(map { (my $x = $_) =~ s/[<>]//g; $x } (split/@/, $Cf->from||"")[1] || HOSTNAME)
	unless $Cf->Helo;
    $Cf->dst(addr(HOSTNAME))		    unless $Cf->dst;

    $Cf->aa("LOGIN")			    unless $Cf->aa || !$Cf->au;



MAIN: {
    die "Config file for exim not readable ".$Cf->config.": $!\n" if not -r $Cf->config;


    my ($w, $r);
    my @cmd = ($Cf->exim, 
	    -C => $Cf->config, 
	    -oMi => addr($Cf->dst),
	    ($Cf->au ? (-oMai => $Cf->au) : ()),
	    ($Cf->aa ? (-oMaa => $Cf->aa) : ()),
	    ($Cf->callout? "-bhc" : "-bh" ) => addr($Cf->src),
	    @ARGV);		    # remaining args are exim native

    if ($Cf->help) {
	($_ = USAGE) =~ s/!(.*?)!/eval $1||""/egs;
	print; exit;
    }

    $@ = "";
    foreach (qw/from to src dst/) {
	$Cf->get($_) or $@ = join " ", $@, $_;
    }
    die ME.": Missing values: $@\n" if $@;

    # my $s = new IO::Select;

    print "**> @cmd\n";

    $SIG{PIPE} = sub { exit };
    my $pid = open3($w, $r, undef, @cmd) or die "Can't run @cmd: $!\n";


     read_exim $r;
    write_exim $w, "EHLO ".$Cf->Helo."\n";
     read_exim $r;
    write_exim $w, "MAIL FROM: ".$Cf->From."\n";
     read_exim $r;

    foreach my $rcpt (split /\s*,\s*/, $Cf->To) {
	write_exim $w, "RCPT TO: $rcpt\n";
	 read_exim $r, "5";
    }
    write_exim $w, "DATA\n";
     read_exim $r;
    write_exim $w, "From: ".$Cf->from."\n";
    write_exim $w, "To: ".$Cf->to."\n";
    write_exim $w, "Subject: Test\n";

    if (not -t STDIN) {
	write_exim $w, "\n";
	while (<>) {
	    write_exim $w, $_;
	}
    }

    write_exim $w, "\n.\n";
     read_exim $r;
    write_exim $w, "QUIT\n";


}

sub read_exim($;$) {
    my $fh = shift;
    my $oh_my_dear = shift || "54";
    while (<$fh>) {
	/^\d\d\d/ and print("< $_") and next;
	/^LOG/ and print and next if $Cf->log;
	print and next if $Cf->debug;
    } continue {
	last if /^\d\d\d\s/;
    }
    exit if defined and /^[$oh_my_dear]/;
}

sub write_exim($@) {
    my $fh = shift;
    print "> ", @_;
    print $fh @_;
}


{
    my %opts;
sub exim_option($) {
    my $opt = shift;
    my $exim = $Cf->exim;
    if (!%opts) {
	%opts = map { chomp; /^(.*?)\s*=\s*(.*)/ ? ($1, $2) : (/no_(.*)/ ? ($1, 0) : ($_, 1)) } grep !/^\s*$/, `$exim -bP`;
    }
    $opts{$opt}
} }


sub addr(@) {
    map { inet_ntoa scalar gethostbyname $_ } @_;
}

# vim:sts=4 sw=4 aw ai sm:
=head1 NAME

exiacl - exim acl tester

=head1 SYNOPSIS

B<exiacl> [options] B<-f>|B<--from>=I<from> B<-t>|B<--to>=I<to[,...]> [-- I<<exim native options>>]

=head1 DESCRIPTION

This tools tests the exim acl, B<including> performing callouts. 

=head1 OPTIONS

=over

=item B<-f>|B<--from> I<sender address>

The mail address of the sender. (no default)

=item B<-l>|B<--[no]log>

Show the log output to stdout. (default: yes)

=item B<-l>|B<--debug>=I<exim debug options>

Call Exim with some debug options. (e.g. C<-d-all+route>).

=item B<--Helo>=I<helo>

Use the specified HELO when talking to Exim (default: current hostname)

=item B<--From>=I<sender>

The envelope-from for the SMTP dialog. (no default)

=item B<--To>=I<recipient>[,I<recipient>...]

The recipients address. You may use more than once addresse, if they're
comma separated. (no default)

=item B<--src>=I<src ip>

The source IP address. (default: some random private address)

=item B<--dst>=I<dst ip>

The destination IP address. This you'll need if you've an Exim running
on more then one interface. (default: IP of the current host)

=item B<--au>=I<user>

Username for authentication. (no default)

=item B<--aa>=I<authenticator>

The authenticator to be used (plain, ....). (no default)

=item B<--exim>=I<exim binary>

The path to the exim binary to be called. (default: exim, but see
L<ENVIRONMENT> below)

=item B<--config>=I<config file>

The config file to be used. (default: /etc/exim/exim.conf, but see
L<ENVIRONMENT> below).

=item B<--[no]callout>

Do callouts (not do not). (default: do callouts)

=back

=head1 ENVIRONMENT

B<EXIM> is used to refer to the exim binary to be called. And
B<EXIM_CONF> is the default configuration file.

=head1 AUTHOR

Heiko Schlittermann L<hs@schlittermann.de>
