#!/usr/bin/perl

# Forward email for a game to the appropriate 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.

# http://www.lifewithqmail.org/lwq.html#environment-variables
# export LOCAL="area-game-pacw-1483459962"
# export DEFAULT="pacw-1483459960"


$" = '';
$\ = "\n";
# Postgres perl library
use Pg;

# Connect to the AREA database

print "Trying to connect to database";
$conn = Pg::connectdb('dbname=area user=areauser password=areapass host=localhost');
print $conn->status;
# 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};
print "1) ".$failaddr;
$failaddr =~ s/-$ENV{DEFAULT}$//;
print "2) ".$failaddr;
$failaddr =~ s/[^-a-zA-Z0-9]//g;
print "3) ".$failaddr;
$failaddr .= '@' . $ENV{HOST};
print "4) ".$failaddr;

print;

print "local:  ".$ENV{LOCAL};
print "host:  ".$ENV{HOST};
print "game:  ".$game;
print "failaddr:  ".$failaddr;

if ($game !~ m/^([A-Z0-9]+)(-([0-9]{1,10}))?$/) {
# No such game, forward to all AREA game contacts
  print "IF didn't match first regex";

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

# As a spam check
$time = time;
print "Time:  ".$time;
if ($time < $timestamp || $time - $timestamp >= 8*60*60) {
  print "Too old";
  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
  print "Something is wrong with the database";
  exit(111);
}

if ($result->ntuples <= 0) {
# No such game, forward to all AREA game contacts
  print "ntuples <= 0";
# 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)
  print "Found";
  print @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.
  print "Weird failure";
}

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