#!/usr/bin/perl -w

# Copyright 2006 Raphaël Hertzog <hertzog@debian.org>
# Available under the terms of the General Public License version 2
# or (at your option) any later version

use lib '/org/packages.qa.debian.org/perl';
use lib '/home/rhertzog/partages/debian/cvs/pts/perl';

use POSIX;
use Mail::Verp;
use DB_File;

use strict;
use vars qw($sendmailnobody $pts_dir);

require "common.pl";

sub do_log {
    $_ = shift;
    open LOG, ">> $pts_dir/logs/bounces-handler.log"
      or die("Couldn't open logfile: $!");
    printf LOG "%s $$ $_\n", strftime("%Y-%m-%d %H:%M:%S", gmtime());
    close LOG;
}

# Extract bounce information
my $lp = $ENV{'LOCAL_PART'} || "";
die "Aren't you exim?" if (! $lp);
my $verp = Mail::Verp->new(separator => '-');
my ($bounce_addr, $recipient) = $verp->decode("$lp\@packages.qa.debian.org");

if ($bounce_addr =~ m/^bounces\+(\d{8})\@packages.qa.debian.org/) {
    my $date = $1;
    do_log "<= received bounce for $recipient/$date";
    # Update stats and check
    open_db_bounces();
    update_bounces_db($date, $recipient, 0);
    my $toomany = has_too_many_bounces($recipient);
    close_db_bounces();
    # Unsubscribe email if it bounces too much
    if ($toomany) {
	do_log ":: too many bounces for $recipient";
	my @msg = ("The email $recipient bounces too much, it has been unsubscribed\n", 
	"from the Debian Package Tracking System. Here's the list of\n",
	"subscriptions wich have been removed:\n");
	for my $pkg (which($recipient)) {
	    do_log ":: removed from $pkg";
	#XXX:    unsubscribe($recipient, $pkg);
	    push @msg, "* $pkg\@packages.qa.debian.org";
	}
	push @msg, "-- \n";
	push @msg, "Debian Package Tracking System\n";
	
	# Generate the mail
	my $mail = MIME::Entity->build(From => 'owner@packages.qa.debian.org',
			 To => $recipient,
			 Subject => "All your subscriptions from the PTS have been cancelled",
			 Encoding => '8bit',
			 'X-Loop' => 'pts@qa.debian.org',
			 'Bcc' => 'archive-outgoing-control@packages.qa.debian.org',
			 Data => \@msg);

	# Send the mail
	#XXX: open(MAIL, "| $sendmailnobody -oi $recipient") || die "Can't fork sendmail: $!\n";
	#$mail->print(\*MAIL);
	#if (not close MAIL) {
	#    do_log "** sendmail: $!";
	#}
    } else {
	do_log ":: not enough bounces to discard $recipient";
    }
} else {
    do_log "%% couldn't extract email from $lp: $bounce_addr $recipient";
}