#!/usr/bin/perl
## Author: Alex Efros <powerman-asdf@yandex.ru>, 2004,2008
## License: Public Domain
##
## deliver: Control email delivery (for .qmail only).
##
## deliver is procmail-like tool. It can analyse incoming email, and either
## reject it with temporary or permanent error, or execute another command
## to continue delivering this email (this command should be given to
## deliver in first param). Rules used to analyse email are written in Perl.
##
## To analyse incoming email deliver execute perl-script ~/.deliver, which
## should either return non-empty string or call SoftError(), HardError() or
## FORWARD().
## If ~/.deliver return non-empty string, it will be saved in environment
## variable $deliver before starting command to continue email delivery.
##
## In ~/.deliver script you can use next functions:
##   1) To reject this email (all these functions call exit()):
##   SoftError('message')    see `man qmail-command`, EXIT CODE = 111
##   HardError('message')    see `man qmail-command`, EXIT CODE = 100
##   2) To forward this email (this function call exec()):
##   FORWARD(@emails_to)     see `man forward`
##   3) To check email headers and content (all these functions return true
##   if 'regexp' match; you can use qr/regexp/ instead of 'regexp'):
##   _FROM('regexp')     Check UUCP-style From_ line that qmail-local adds
##                       to mbox-format files.
##   _BODY('regexp')     Check email body.
##   From('regexp')      Check header From:
##   To('regexp')        Check header To:
##   Reply_To('regexp')  Check header Reply-To:
##   ...                 You can call any other functions to check any
##                       other email headers ("-" in header name should be
##                       replaced by "_" in function name, function names
##                       are case-insensitive)
## 
## Example:
##
##   1) Add something like this to your ~/.deliver :
##
##      From('good_email1a|good_email1b')            &&  'mailbox1'
##   || (From('good_email2') or CC('good_email2'))   &&  'mailbox2'
##   || _BODY('Windows|Microsoft')                   &&  'windows'
##   || From('bad_email1')                           &&  HardError('SPAM!')
##   || From('bad_email2')                           &&  FORWARD('spam@host')
##   ||                                                  'default'
##
##   2) Add these lines to your ~/.qmail :
##   # deliver email to ~/Mail/$deliver ($deliver value is result of ~/.deliver)
##   |deliver 'qmail-local "$USER" "$HOME" "$LOCAL" "" "nodeliver" "$HOST" "$SENDER" "./Mail/$deliver"'

use version; our $VERSION = qv('v2.1.0');

exec "grep '^##' \Q$0\E | sed s,^...\\\\?,,"
    if !@ARGV || $ARGV[0] eq '-h' || $ARGV[0] eq '--help';

my ($head, $Body) = split /^$/m, join("", $ENV{RPLINE},$ENV{DTLINE},<STDIN>), 2;
seek \*STDIN, 0, 0 or SoftError("seek: $!");
my %Header;
for (split /^(?=\S+:)/m, $head) {
    my ($name, $value) = /^(\S+):(.*)/s;
    $name = lc($name);
    $name =~ s/-/_/g;
    $Header{$name} .= $value;
}

sub _FROM   { $ENV{UFLINE}  =~ /$_[0]/im }
sub _BODY   { $Body     =~ /$_[0]/im }
sub AUTOLOAD    { $AUTOLOAD=~s/.*:://; $Header{lc($AUTOLOAD)}   =~ /$_[0]/im }
sub SoftError   { warn "$_[0]\n" if $_[0] ; exit 111 }
sub HardError   { warn "$_[0]\n" if $_[0] ; exit 100 }
sub FORWARD     { exec 'forward', @_; SoftError("Can't exec: @_") }

my $deliver = do '.deliver';
SoftError("ERROR in ~/.deliver : $!$@")
    if !defined $deliver and ($! or $@);
SoftError('ERROR: ~/.deliver return empty string')
    if !defined $deliver or $deliver eq q{};

$ENV{deliver} = $deliver;
exec $ARGV[0];
SoftError("Can't exec: $ARGV[0]");

