#!/usr/athena/bin/perl

BEGIN {
  if (-d '/data/rt2/lib') {
    eval <<'EOF';
      use lib '/data/rt2/lib';
      use lib '/data/rt2/etc';
      use RT::Interface::CLI qw(CleanEnv LoadConfig DBConnect);
use RT::Tickets;
      use RT::CurrentUser;
      use RT::Ticket;
      use RT::Keyword;
      use MIME::Entity;
EOF
  }
}

use Getopt::Std;
use IO::File;
use HTTP::Request;
use LWP::UserAgent;
use strict 'vars';
use vars qw(%opts @id_dirs @keywords @exceptions %abstract @drafts $process);
use vars qw(%Area_Desc %Area_WG %WG_Desc %WG_Area);
use vars qw($RT_User $RT_Queue %RT_Keywords %RT_KWselects);

@keywords = (
  [ 'kerberos'            => 'Kerberos' ],
	['sp?nego' => 'spnego'], 
  [ 'gss-?api'            => 'GSSAPI' ],
  [ '\bssl\b'             => 'TLS' ],
  [ '\bw?tls\b'           => 'TLS' ],
  [ 'sasl'                => 'SASL' ],
);

@id_dirs = qw(
  /mit/internet-drafts
  /afs/andrew.cmu.edu/common/internet-drafts
);

print STDERR '$Id: brute-squad-scanner.pl,v 1.13 2001/07/24 14:42:52 hartmans Exp $', "\n";

# Parse options
getopts('hdvm:D:w:x:O:', \%opts) or die "unknown option!\n";
if ($opts{'h'}) {
  print STDERR "Usage: $0 [options]\n";
  print STDERR "Options (defaults in []):\n";
  print STDERR "   -h       Display help message\n";
  print STDERR "   -d       Enable debugging output\n";
  print STDERR "   -v       Enable verbose output\n";
  print STDERR "   -m mode  Processing mode [stdout]\n";
  print STDERR "   -D path  Path to internet drafts\n";
  foreach (@id_dirs) { print STDERR "            [$_]\n" }
  print STDERR "   -w URL   Location of the 1wg-summary.txt file\n";
  print STDERR "            [ftp://ftp.ietf.org/ietf/1wg-summary.txt]\n";
  print STDERR "   -x path  Path to exceptions file [exceptions]\n";
  print STDERR "   -O xxx   Output location (path, address, etc)\n";
  print STDERR "Operating modes:\n";
  print STDERR "   stdout   Print to stdout\n";
  print STDERR "   files    Produce files in dir [/var/tmp/brute-squad]\n";
  print STDERR "   rt       Generate rt entries in queue [brute-squad]\n";
  exit(0);
}
$opts{'m'} ||= 'stdout';
$opts{'w'} ||= 'ftp://ftp.ietf.org/ietf/1wg-summary.txt';
$opts{'x'} ||= 'exceptions';

if (!$opts{'D'}) {
  foreach (@id_dirs) {
    next unless -d $_;
    $opts{'D'} = $_;
    last;
  }
}

if      ($opts{'m'} eq 'stdout') {
  $process = \&process_stdout;

} elsif ($opts{'m'} eq 'files') {
  $opts{'O'} ||= '/var/tmp/brute-squad';
  if (! -d $opts{'O'}) {
    mkdir($opts{'O'}, 0755) or die "$opts{'O'}: $!\n";
  }
  $process = \&process_files;

} elsif ($opts{'m'} eq 'rt') {
  $opts{'O'} ||= 'brute-squad';
  init_rt();
  $process = \&process_rt;

} else {
  die "Unknown mode $opts{'m'}\n";
}

# Read in file of exceptions
# If the draft name matches any of these then ignore it
if (-f $opts{'x'}) {
  print STDERR "Reading exceptions...\n";
  open (EXCEPTIONS, $opts{'x'})
    or die "Unable to open $opts{'x'}: $!\n";
  @exceptions = map {chomp;($_) = split} <EXCEPTIONS>;
  close(EXCEPTIONS);
}

chdir $opts{'D'} or die "$opts{'D'}: $!\n";

# Read in 1wg-charters
parse_charters();

# Read in 1id-abstracts.
# We assume an abstract for a draft is a paragraph containing <draft-name.txt>
# followed by a paragraph of text.
print STDERR "Reading 1id-abstracts.txt...\n";
open(ABS, "1id-abstracts.txt")
	or die "Unable to open abstracts file: $!\n";
undef $/;
my @chunks = split(/\n\s*\n/, scalar(<ABS>));

for (my $i = 0; $i < $#chunks; $i++) {
  if ($chunks[$i] =~ /<([\-\w\d\.]+)>/) {
    $abstract{$1} = $chunks[$i]. "\n\n".$chunks[$i+1];
  }
}
$/ = "\n";
close(ABS);


#Now, read in the drafts
if (@ARGV) {
  @drafts = @ARGV;
} else {
  @drafts = glob("draft-*.txt");
}

@drafts = sort {
  my $aa = $a=~ /ietf/?"0$a":"1$a";
  my $bb = $b=~ /ietf/?"0$b":"1$b";
  $aa cmp $bb;
  } @drafts;

foreach my $draft (@drafts) {
  my($draft_name, $draft_vers, $text);

  if ($draft =~ /-(\d+)\.txt$/) {
    ($draft_name, $draft_vers) = ($`, $1);
  } else {
    ($draft_name, $draft_vers) = ($draft, undef);
  }
  next if grep {$draft =~ /$_/} @exceptions;
  open(DRAFT, "$draft")
    or die "Unable to open $draft: $!\n";
  my @lines = <DRAFT>;
  my (@matches, %kwmatch);
  for (my $i = 0; $i < $#lines; $i++ )  {
    my @kw_ents = grep { $lines[$i] =~ /$$_[0]/i } @keywords;
    if ( @kw_ents ) {
      foreach (@kw_ents) {
        @_ = @$_; shift @_;
        map { $kwmatch{$_} = 1 } @_;
      }
      push @matches, $i-1 unless $i == 0;
      push @matches, $i;
      push @matches, $i+1;
    }
  }
  if (@matches) {
    $text = $abstract{$draft} . "\n\n";
    my($cur) = 0;
    foreach(@matches[0..8]) {
      next unless $lines[$_]; # Not sure if we might create blank entries
      $cur == $_ 
	or $text .= "$_: ".$lines[$_];
      $cur = $_;
    }
    $process->($draft, $draft_name, $draft_vers,
               [ keys %kwmatch ], $abstract{$draft}, $text);
  }
}


sub parse_charters {
  my($area, $wg, $wglist, $name, $desc);
  my($UA, $Request, $Response, @lines);

  print STDERR "Reading 1wg-charters.txt...\n";
  $UA = new LWP::UserAgent();
  $UA->from('id-scanner@grand.central.org');
  $Request = new HTTP::Request(GET => $opts{'w'});
  $Response = $UA->request($Request);
  if (!$Response->is_success) {
    print STDERR "$opts{'w'}: ", $Response->status_line, "\n";
    die "Failed to get 1wg-charters.txt file!\n";
  }
  @lines = split(/\n/, $Response->content);

  foreach (@lines) {
    next unless /^\S/;

    if (/^-/) {
      $Area_WG{$name} = $wglist = [];
      $Area_Desc{$name} = $desc;
      $area = $name;
      $name = undef;
      next;
    }

    if (defined($name)) {
      $WG_Desc{$name} = $desc;
      $WG_Area{$name} = $area;
      push(@$wglist, $name);
    }

    if (/\s*\(([-\w]+)\)$/) {
      $desc = $`;
      $name = $1;
    }
  }

  if (defined($name)) {
    $WG_Desc{$name} = $desc;
    $WG_Area{$name} = $area;
  }

  if ($opts{'d'} && $opts{'v'}) {
    foreach $area (sort keys %Area_WG) {
      print STDERR "** $area - $Area_Desc{$area}\n";
      foreach $wg (sort @{$Area_WG{$area}}) {
        print STDERR "   $wg - $WG_Desc{$wg} [$WG_Area{$wg}]\n";
      }
      print STDERR "\n";
    }
  }
}


## MODE: stdout

sub process_stdout {
  my($draft, $draft_name, $draft_vers, $kwmatch, $abstract, $text) = @_;

  print $text;
  print "\n\n";
}


## MODE: files

sub process_files {
  my($draft, $draft_name, $draft_vers, $kwmatch, $abstract, $text) = @_;

  print ">>> $draft\n";
  my $path = "$opts{'O'}/$draft";
  my $F = new IO::File($path, O_WRONLY|O_CREAT|O_TRUNC, 0644)
    or die "$path: $!\n";
  print $F "** $draft\n\n";
  print $F $text;
  $F->close;
}


## MODE: rt

sub init_rt {
  my($id);
  CleanEnv();
  LoadConfig();
  DBConnect();

  $RT_User = new RT::CurrentUser;
  $RT_User->LoadByName('id-scanner');

  $RT_Queue = new RT::Queue($RT_User);
  $id = $RT_Queue->Load($opts{'O'});
  die "Unable to load RT queue $opts{'O'}\n" unless defined $id;
}


sub rt_check_keyword {
  my($kwpath) = @_;
  my($Keyword, $trans, $msg, $parent, $name, $desc);

  if (!exists($RT_Keywords{$kwpath})) {
    $Keyword = new RT::Keyword($RT_User);
    ($trans, $msg) = $Keyword->LoadByPath($kwpath);
    if (!$trans) {
      print $msg, "\n" if $opts{'v'} || $opts{'d'};
      if ($kwpath =~ m#/([^/]+)$#) {
        $name = $1;
        $parent = $`;
        if ($parent eq '/kbs/area')        { $desc = $Area_Desc{$name} }
        if ($parent eq '/kbs/origin/ietf') { $desc = $WG_Desc{$name} }
        $parent = rt_check_keyword($parent);
        ($trans, $msg) = $Keyword->Create(Name => $name, Parent => $parent);
      } else {
        ($trans, $msg) = $Keyword->Create(Name => $kwpath);
      }
      print $msg, "\n" if $opts{'v'} || $opts{'d'} || !$trans;
      die "keyword creation failed!\n" if !$trans;
    }
    $RT_Keywords{$kwpath} = $Keyword->id();
  }
  $RT_Keywords{$kwpath};
}


sub rt_check_kwselect {
  my($kw) = @_;
  my($KeywordSelect, $id);

  if (!exists($RT_KWselects{$kw})) {
    $KeywordSelect = new RT::KeywordSelect($RT_User);
    $id = $KeywordSelect->LoadByName(Name => $kw, Queue => $RT_Queue->id());
    die "Failed to load kwselect $kw\n" unless $id;
    $RT_KWselects{$kw} = $id;
  }
  $RT_KWselects{$kw};
}


sub process_rt {
  my($draft, $draft_name, $draft_vers, $kwmatch, $abstract, $text) = @_;
  my($Ticket, $MIMEObj, $id, $trans, $msg, $url);
  my(%keywords, $kw, $vals);

	# Set up values we need both for add and modify
	  $url = "http://www.ietf.org/internet-drafts/$draft";
	my $subject = "ID: $draft_name";
$keywords{'matches'} = [ map("/kbs/match/$_", @$kwmatch) ];
if ($draft_name =~ /draft-ietf-(krb-wg|[^-]+)-/) {
$keywords{'origin'} = [ "/kbs/origin/ietf/$1" ];
$keywords{'area'}   = [ "/kbs/area/$WG_Area{$1}" || '/kbs/area/none' ];
} else {
$keywords{'origin'} = [ '/kbs/origin/individual' ];
$keywords{'area'}   = [ '/kbs/area/none' ];
}

	# See if ticket already exists.
my $RT_Tickets = new RT::Tickets ($RT_User);
	$RT_Tickets->LimitSubject (
VALUE => $subject,
OPERATOR => '=');
my $Ticket = $RT_Tickets->Next ();
	unless ($Ticket) {
print "*** Adding report for $draft\n";

# Build the content
$MIMEObj = MIME::Entity->build(From     => 'id-scanner@grand.central.org',
Subject  => "Please examine $draft_name",
Data     => $text);

# Create the ticket
$Ticket = new RT::Ticket($RT_User);
($id, $trans, $msg) =
$Ticket->Create( Queue           => $RT_Queue,
Status          => 'new',
Subject         => $subject,
InitialPriority => 20,
FinalPriority   => 0,
MIMEObj         => $MIMEObj,
);
print $msg, "\n" if $opts{'v'} || $opts{'d'} || !$id;
die "RT ticket creation failed!\n" unless $id;
# Add a link to the draft
($trans, $msg) = $Ticket->AddLink(Type => 'RefersTo', Target => $url);
print $msg, "\n" if $opts{'v'} || $opts{'d'} || !$trans;
			} else { #Existing ticket
	# Now we need to see if  the draft has updated
# We do this by trying to create  a link to  the new draft
#If this succeeds,  then we haven't seen this version yet.
	# We have to search the message because of inconsistent return types
	# in AddLink
	  ($trans, $msg) = $Ticket->AddLink(Type => 'RefersTo', Target => $url);
	print $msg, "\n" if $opts{'v'} || $opts{'d'} ;
	if ($msg =~ /already\s+exists/) {
	  print "***Skipping $draft: Already seen\n";
	  return;
	}
	# Build the content
	$MIMEObj = MIME::Entity->build(From     => 'id-scanner@grand.central.org',
				       Subject  => "Please examine updated $draft_name",
				       Data     => $text);
	print "***Recording update for $draft\n";
	if ($Ticket->Status () eq 'stalled') {
	  ($trans, $msg) = $Ticket->SetStatus('open');
	  print $msg, "\n" if $opts{'v'} || $opts{'d'} || !$$trans;
	  die "Unable to set status\n" unless $trans;
	  ($trans, $msg) = $Ticket->Correspond (MIMEObj => $MIMEObj);
	  print $msg, "\n" if $opts{'v'} || $opts{'d'} || !$$trans;
	  die "Unable to set status\n" unless $trans;
	} elsif ($Ticket->Status() eq 'resolved') {
	  ($trans, $msg) = $Ticket->Comment (MIMEObj => $MIMEObj);
	  print $msg, "\n" if $opts{'v'} || $opts{'d'} || !$$trans;
	  die "Unable tocomment\n" unless $trans;
	  # Some versions of RT helpfully unresolve tickets.
	  # We don't want that here.
	  $Ticket->SetStatus ('resolved');
	} else {
	  	  ($trans, $msg) = $Ticket->Correspond (MIMEObj => $MIMEObj);
	  print $msg, "\n" if $opts{'v'} || $opts{'d'} || !$$trans;
	  die "Unable to correspond\n" unless $trans;
		  }
	}
  # Add keywords
  while (($kw, $vals) = each %keywords) {
    $kw = rt_check_kwselect($kw);
    print "keywordselect id = $id\n" if $opts{'d'};
    foreach (@$vals) {
      $id = rt_check_keyword($_);
      print "keyword id = $id\n" if $opts{'d'};
      ($trans, $msg) = $Ticket->AddKeyword(KeywordSelect => $kw,
                                           Keyword       => $id);
      print $msg, "\n" if $opts{'v'} || $opts{'d'} || !$trans;
    }
  }
}