#!/usr/bin/perl
# fupcheck.pl (c) -thh 07/2007
# based on cancelwatch.pl by Ralf Doeblitz
#
# use with a newsfeeds entry like this:
#   fupcheck!:*:Tc,Ap,WnstH:/usr/local/bin/fupcheck
#

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

# Each pattern is a key in this hash, value is the address
# notices should be mailed to.
# The patterns should match the _complete_ FQDN, i.e. everything between
# '@' and '>' in the Message-ID
my %pattern = (
               '(your-fqdn.example)' => 'your-mail@your-host.example'
              );

# sender address
my $from = 'news@your-host.example';

#######################################
### 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;
  # next lines added by -thh 2007-07-22
  # catch empty lines trailing or leading
  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;

  # process posting
  # get target message-id
  my ($target) = ($header{'references'} =~ 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 posting to configured address
      my $mail = MIME::Lite->new(
              From => $from,
              To => $pattern{$pattern},
              Subject => "Followup to $target received at ".time2str('%Y-%m-%d %T', $timerec),
              Type => 'TEXT',
              Data => $artbody);
      $mail->send();
    }
  }
}