#!/usr/bin/perl -w

# Copyright 2002 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/cvs/pts/perl';

use Mail::Internet;
use Mail::Address;
use DB_File;

use strict;
use vars qw($db $sendmail);

=head1 Script for *@packages.qa.debian.org

=head1 INSTALLATION INSTRUCTIONS

This script needs libmailtools-perl.

=cut

require "common.pl";

# Local configuration variables
my $nb_by_group = 20; # Number of emails sent together (in the same sendmail)
my $debug = 0;
my $spamc = '';

# Get the package name
my $package = lc($ENV{'LOCAL_PART'}); # Exim sets that ...
$package = lc(shift @ARGV) if ($debug && defined($ARGV[0]) && $ARGV[0]); # 
die "Aren't you exim ?" if (! (defined($package) && $package));

# Get the keyword name
my $keyword = '';
if ($package =~ /(\S+)_(\S+)/) {
    $package = $1;
    $keyword = $2;
}

# Get the list of subscribers
open_db_read();
my @emails = $db->get_dup($package);
exit 0 if (! scalar(@emails)); # Don't parse anything if nobody is subscribed

# Parse the mail
my $mail = Mail::Internet->new(\*STDIN) or die "Parse failed !\n";

# Stop if bad X-Loop
my @xloop = grep { m/$package\@packages.qa.debian.org/ } 
		 ($mail->head()->get('X-Loop'));
if (scalar(@xloop)) {
    exit 0;
}

# Find the real keyword
if (! $keyword) {
    $keyword = 'default';
    if (scalar(grep { m/owner\@bugs\.debian\.org/ } 
		    ($mail->head()->get('X-Loop'))
	      )
	and $mail->head()->get('X-Debian-PR-Message')
       )
    {
	$keyword = 'bts';
    } elsif (scalar(grep { m/debbugs\@master\.debian\.org/ }
		    ($mail->head()->get('Sender'))
		   )
	     and ($mail->head()->get('Subject') =~ /^Processed:/)
	    )
    {
	$keyword = 'bts-control';
    } elsif (($mail->head()->get('X-Katie') or $mail->head()->get('X-Lisa'))
    	     and
	     ($mail->head()->get('Subject') =~ /^Accepted|INSTALLED|ACCEPTED/) and
	     (scalar(grep { /\.dsc\s*$/ } @{$mail->body()}))
	    )
    {
	exit(0) if ($mail->head()->get('Subject') =~ /INSTALLED|ACCEPTED/);
	$keyword = 'upload-source';
    } elsif (($mail->head()->get('X-Katie') or $mail->head()->get('X-Lisa'))
             and
	     ($mail->head()->get('Subject') =~ /^Accepted|INSTALLED|ACCEPTED/)
	    )
    {
	#exit(0) if ($mail->head()->get('Subject') =~ /INSTALLED|ACCEPTED/);
	$keyword = 'upload-binary';
    } elsif ($mail->head()->get('X-Katie') or $mail->head()->get('X-Lisa'))
    {
	$keyword = 'katie-other';
    }
}

# Build the real list of interested people
my $wantmail = sub {
    my $address = shift;
    foreach (get_tags($address, $package)) {
	return 1 if ($_ eq $keyword);
    }
    return 0;
};
@emails = grep { &$wantmail($_) } @emails;
exit 0 if (! scalar(@emails));
close_db();

# If default keyword, it may be spam ... check with spamassassin
# before approving
if ($keyword eq "default") {
    if (defined($spamc) && $spamc) {
	open(SPAMC, "| $spamc -c >/dev/null") || die "Can't fork spamc: $!\n";
	$mail->print(\*SPAMC);
	my $res = close(SPAMC);
	if (!$res and !$!) {
	    # Looks like it's spam
	    print STDERR "Your message appears to be spam (according to spamassassin).";
	    print STDERR "If it wasn't please retry by writing simple plain text mails.";
	    exit 2;
	}
    }
}

# Modify the mail
$mail->head()->add("X-Loop", "$package\@packages.qa.debian.org");
$mail->head()->add("X-PTS-Package", $package);
$mail->head()->add("X-PTS-Keyword", $keyword);
$mail->head()->add("X-Unsubscribe", 
	"echo 'unsubscribe $package' | mail pts\@qa.debian.org");

# Forward the mail ... by group of $nb_by_group addresses
my @send;
while (defined($_ = shift @emails)) {
    push @send, $_;
    if (scalar(@send) == $nb_by_group) {
	send_mail(@send);
	@send = ();
    }
}
send_mail(@send) if (scalar(@send));

sub send_mail {
    open(MAIL, "| $sendmail -oi @_") || die "Can't fork sendmail: $!\n";
    $mail->print(\*MAIL);
    close MAIL or warn "Problem happened with sendmail: $!\n";
}