#!/usr/bin/perl

# Forward email for a game to the appropiate contact
# Bruno Wolff III
# Last updated November 6, 2006

# This program depends on qmail semantics for program delivery.
# It should be called using preline -r -f to add a delivered-to header
# to catch mail loops.

$" = '';

# Postgres perl library
use Pg;

# Path to qmail-inject binary
$qmail = '/var/qmail/bin/qmail-inject';

# Shut off STDERR so Pg doesn't write to it
close(STDERR);
open(STDERR, '>/dev/null');

# Connect to the AREA database

$conn = Pg::connectdb('dbname=area');
# Give a temporary failure if the database is unreachable
exit(111) if $conn->status != PGRES_CONNECTION_OK;

# Get which game we are interested in and forward to AREA if it can't be good
$game = uc($ENV{DEFAULT});
$failaddr = $ENV{LOCAL};
$failaddr =~ s/-$ENV{DEFAULT}$//;
$failaddr =~ s/[^-a-zA-Z0-9]//g;
$failaddr .= '@' . $ENV{HOST};

if ($game !~ m/^([A-Z0-9]+)(-([0-9]{1,10}))?$/) {
# No such game, forward to all AREA game contacts
  exec($qmail, "-fbruno\@$ENV{HOST}", $failaddr);

# The forward failed
  exit(111);
}
$game = $1;
$timestamp = $3;

# As a spam check
$time = time;
if ($time < $timestamp || $time - $timestamp >= 8*60*60) {
  exit(100);
}

# Get recipient address and quote it
$rec = $ENV{RECIPIENT};
$rec =~ s/\\|'/\\$&/g;

# This program shouldn't send stuff to its own address.
$result = $conn->exec("select email from contacts, games where contacts.contact = games.contact and games.gameid = '$game' and email not ilike '$rec'");
if ($result->resultStatus != PGRES_TUPLES_OK) {
# Something is wrong with the database
  exit(111);
}

if ($result->ntuples <= 0) {
# No such game, forward to all AREA game contacts
  exec($qmail, "-fbruno\@$ENV{HOST}", $failadr);

# The forward failed
  exit(111);
}

@add = ();
while (@row = $result->fetchrow) {
  if (defined $row[0] && $row[0] ne '') {
    push @add, $row[0];
  }
}

if (scalar(@add) > 0) {
# forward to contact address(es) (currently there should be exactly one)
  exec($qmail, "-fbruno\@$ENV{HOST}", @add);
}
else {
# If we get here there was either a weird failure or the database structure
# changed to allow null email addresses and that was all that was returned.
# It is safer to send this on to the fallback address rather than return
# a temporary failure as it might be a relatively permanent failure.
  exec($qmail, "-fbruno\@$ENV{HOST}", $failadr);
}

# If we get here the exec statements failed for some reason. Lets hope
# that whatever was wrong gets fixed.
exit(111);