#!/usr/bin/perl -w

use strict;
use lib '/opt/hare/lib';

use Email::Simple;
use POSIX qw( strftime );
use Hare;

my $hare = Hare->new();

my $mailtext = do { local $/; <STDIN> };
my $msg = Email::Simple->new( $mailtext );

my @from = split( m/,/, $msg->header( "From" ) );
my @to   = map { split( m/,/, $msg->header( $_ ) || "" ) } ( "To", "Cc", "Bcc" );

# Trim whitespace
s/^\s+//, s/\s+$// for @from, @to;

# Extract <local@host> part if found
m/<(\S+@\S+)>/ and $_ = $1 for @from, @to;

my $policy;

my @matching_to;

# Look for any To address we handle
TO: foreach my $to ( @to ) {
   next unless $hare->is_matching_to( $to );

   push @matching_to, $to;

   foreach my $from ( @from ) {
      my $p = $hare->get_policy( $to, $from );
      $policy = $p, last TO if defined $p;
   }
}

if( $policy and $policy == ALLOW ) {
   print STDERR "[haretrap] We allow this message\n";

   print $mailtext;
   exit( 0 );
}
elsif( $policy and $policy == DENY ) {
   print STDERR "[haretrap] We do not allow this message\n";

   exit( 1 );
}
elsif( @matching_to ) {
   print STDERR "[haretrap] No policy but we do at least recognise to addresses @matching_to\n";
   my $mailid = $hare->archive_message( $mailtext );

   my $text = "From " . join( ", ", @from ) . "; To " . join( ", ", @matching_to );

   $hare->push_poke_queue( $mailid, $text );

   exit( 1 );
}
else {
   print STDERR "[haretrap] No policy for unrecognised to addresses @to\n";
   my $mailid = $hare->archive_message( $mailtext );

   my $response = $hare->run_template( "mail/new-from",
      {
         mailid => $mailid,
         from   => \@from,
         to     => \@to,
         date   => strftime( "%a, %d %b %Y %H:%M:%S %z", localtime ),
      } );

   print $response;
   exit( 0 );
}