#!/usr/bin/perl
# $Id: cancelwatch,v 1.1 2000/12/06 23:18:17 doeblitz Exp $
#
# watch for cancels against selected sites
# use with a newsfeeds entry like this:
#   cancelwatch!:*:Tc,Ap,WnstH:/usr/local/bin/cancelwatch
#
# $Log: cancelwatch,v $
# Revision 1.1  2000/12/06 23:18:17  doeblitz
# Initial revision
#

require '/etc/news/innshellvars.pl';
use strict;
use Date::Format;
use MIME::Lite;

# Each pattern is a key in this hash, value is the address cancel
# notices should be sent to.
# The patterns should match the _complete_ FQDN, i.e. everything between
# '@' and '>' in the Message-ID
my %pattern = 
  (
   '(.+\.)*netzverwaltung\.net'
   => 'INSERT.YOUR.MAILADDRESS.HERE',
  );

# sender address
my $from = 'cancelwatch@INSERT.YOUR.HOSTNAME.HERE';

#######################################
### No User Serviceable Parts Below ###
#######################################

sub safe_pipe_fork($) {
    my ($pid, $sleep_count);
    my $name=shift;

    do {
        $pid = open(KID, $name);
        unless (defined $pid) {
            warn "cannot fork: $!";
            die "bailing out" if $sleep_count++ > 6;
            sleep 10;
        }
    } until defined $pid;

    return ($pid);
}

sub safe_pipe_read(@) {
    my @cmd = @_;
    my $pid = safe_pipe_fork('-|');

    if ($pid) {			# parent
        my @a=<KID>; 
        close KID or die "child exited: $?";
        return @a;
    } else {
        exec { $cmd[0] } @cmd;
        exit -1;
    }
}

while (<>) {
    # first line contains token, site, time
    chomp;
    if ($_ eq '') {
	next;
    }
    my ($token, $site, $timerec) = split;

    # remaining lines contain headers
    my $header = "";
    while (<>) {
	chomp;
	# empty line terminates this article
	if ($_ eq '') {
	    last;
	}
	# collect headers
	$header .= $_."\n" ;
    }

    # unfold header
    $header =~ s/\n\s+/ /gs;

    # split and enter into hash
    my @header = split(/\n/, $header);
    my %header = map { split(/:\s/, lc $_, 2) } @header;
  
    # check for cancel/supersede, first match counts
    my $type;
    if ($header{'control'} =~ /cancel/ ||
	$header{'also-control'} =~ /cancel/) {
	$type = "cancel";
    } elsif (defined $header{'supersedes'}) {
	$type = "supersedes";
    } elsif ($header{'subject'} =~ /cmsg\s+cancel/) {
	$type = "cancel";
    }

    # process cancel
    if (defined $type) {
	# get target message-id
	my ($target) = ($header{'control'} =~ m/(<.*>)/);
	unless (defined $target) {
	    ($target) = ($header{'also-control'} =~ m/(<.*>)/);
	}
	unless (defined $target) {
	    ($target) = ($header{'supersedes'} =~ m/(<.*>)/);
	}
	unless (defined $target) {
	    ($target) = ($header{'subject'} =~ m/(<.*>)/);
	}
	# test all patterns
	for my $pattern (keys %pattern) {
	    if ($target =~ /$pattern/) {
		# replace token by relative path
		my @artbody = safe_pipe_read("$inn::newsbin/sm", $token);
		my $artbody = join("", @artbody);
		# mail cancel to configured abuse address
		my $timerecfmt = time2str('%Y-%m-%d %T', $timerec);
		my $mail = MIME::Lite->
		  new(
		      From => $from,
		      To => $pattern{$pattern},
		      Subject => "$type against $target received at $timerecfmt",
		      Type => 'TEXT',
		      Data => $artbody);
		$mail->send();
	    }
	}
    }
}

# end of file