#!/usr/bin/perl -w

# anlayses mbox with incoming incrementals to detect which server
# sends incremental to which other server


my $staticReadOneMailFrom; 

my $debug= 5; 

&main();

sub main {
  if ($#ARGV != 0) {
    print STDERR "usage: $0 inbox\n";
    exit(1);
  } else {
    my $file= $ARGV[0];
    open(INF, "<$file") || die "could not open $file for reading\n";
  }
  my %fromAliases= (
      'pks-admin@horowitz.surfnet.nl' => 'pks-admin@keys.nl.pgp.net',
      'peter.wan@cc.gatech.edu' => 'pgpkserv@cc.gatech.edu', 
      'peter@cc.gatech.edu' => 'pgpkserv@cc.gatech.edu',
      'mailer-daemon@mars.wazoo.com' => 'wazoo@wazoo.com',
      'mailer-daemon@cirrus.ulpgc.es' => 'pksadmin@cirrus.ulpgc.es',
      'mailer-daemon@pleiades.ns.ca' => 'pgp-admin@pleiades.ns.ca',
      'nobody@pgp.arl.wustl.edu' => 'pks-admin@pgp.arl.wustl.edu'
      );
  my ($sender);

  foreach $key (keys %fromAliases) {
      print "alias $key -> ", $fromAliases{$key}, "\n";
  }
  print "\n";

  while (!eof(INF)) {
      my ($body, $subject, $from, $fromP, $to, %head)= readOneMail(INF);
      if ($subject =~ /incremental/i) {
	  #print "From $from\n";
	  #print "From: $fromP\n";
	  #print "To: $to\n";
	  #print 'X-KeyServer-Sent: ', $head{'X-KeyServer-Sent'};
	  #print "\n";
	  # ----- extract email from the from header
	  chomp($from);
	  $from=~ s/^(.*?)( )*([^ ]*@[^ ]*)( )*(.*)$/$3/;
	  $from= lc($from);
	  if (defined($fromAliases{$from})) {
	      $from= $fromAliases{$from};
	  }
	  $fromP=~ s/^(.*?)( )*<*([^ ]*@[^ >]*)>*(.*)$/$3/;
	  $fromP= lc($fromP);
	  if (defined($fromAliases{$fromP})) {
	      $fromP= $fromAliases{$fromP};
	  }
	  if ($fromP !~ /$from/) {
	      if (defined($unknownAlias{$from}) && ($unknownAlias{$from} eq $fromP)) {
		  # already seen 
	      } else {
		  print "From  $from\n";
		  print "From: $fromP\n";
		  print "-----------\n";
		  $unknownAlias{$from}= $fromP;
	      }
	  } 
	  $sender= $from;
	  if (! defined($head{'X-KeyServer-Sent'})) {
	      @xkeys= ();
	  } else {
	      @xkeys= sort(split(/,/, lc($head{'X-KeyServer-Sent'})));
	  }
	  @tos= sort(split(/,/, lc($head{'To'})));
	  foreach $to (@tos) {
	      $to= &trim($to);
	      if (! defined($sendingto{$sender}{$to})) {
		  $sendingto{$sender}{$to}= 0;
	      }
	      $sendingto{$sender}{$to}++;
	  }
      } else {
	  print STDERR " ignoring mail with subject: $subject\n";
      }
  }

  # number all addresses for easier reference
  my $nr= 1;
  foreach $from (sort keys %sendingto) { 
      $from=~ s/(.*)(@.*)/$2/;
      $nr{$from}= $nr++;
  }
  foreach $from (sort keys %sendingto) { 
      foreach $to (keys %{$sendingto{$from}}) {
	  $to=~ s/(.*)(@.*)/$2/;
	  if (! defined($nr{$to})) {
	      $nr{$to}= $nr++;
	  }
      }
  }
	  

  foreach $from (sort keys %sendingto) { 
      $res= '';
      $fromdom= $from;
      $fromdom=~ s/(.*)(@.*)/$2/;
      $res.= "\nFrom: $from (" . $nr{$fromdom} . ")\n";
      my $lastto= '';
      my $count= 0;
      my $totcount= 0;
      foreach $to (keys %{$sendingto{$from}}) {
	  $count= $sendingto{$from}{$to};
	  $tmp= '';
	  $todom= $to;
	  $todom=~ s/(.*)(@.*)/$2/;
	  if (defined($nr{$todom})) {
	      $tmp= sprintf(" (%3d)", $nr{$todom});
	  }
	  $tmp= ' 'x(50-length($to)) . $tmp;
	  $res.= sprintf("%7d $to$tmp\n", $count);
	  $totcount+= $count;
      }
      if ($totcount > 0) {
	  print $res;
      }
  }
}

sub readOneMail {
  my ($fh)= @_;
  my ($from, $body, $line, %header, $orgline);
  my $end= eof($fh);
  if (defined $staticReadOneMailFrom) {
      $from= $staticReadOneMailFrom;
  }
  $body= '';
  my $lastLine= '';
  my $inHeader= (1==1); # we are in mail header
  my $lastHeader= '';
  while (! $end) {
    $line= <$fh>;
    if ($inHeader) {
	if ($line=~ /^$/) {
	    $inHeader= (0==1);
	} else {
	    print "Header-Line: $line" if $debug > 5;
	    $orgline= $line;
	    chomp($line);
	    if ($line =~ /^( |\t)/) {
		# are in multi line header
		if (length($lastHeader) > 0) {
		    # already found one header with that name. Append content 
		    $tmp= $line;
		    $tmp=~ s/\t/ /g;
		    $tmp=~ /^( *)(.*)$/;
		    $header{$lastHeader}.= $2;
		} else {
		    die "incorrect mail header format: line starting with space: '$line'\n";
		}
	    } else {
		# new mail header line found
		if ($line =~ /^From /)    { 
		    if (defined $staticReadOneMailFrom) {
			die "no From should be found here!\n"; 
		    } else {
			$from= $orgline;
		    }
		} else {
		    # remember this header name
		    $lastHeader= $line;
		    $lastHeader=~ s/^(.*):(.*)$/$1/;
		    if (length($lastHeader) > 0) {
			$line=~ /^(.*):( *)(.*)$/;
			if (defined $header{$lastHeader}) {
			    $header{$lastHeader}.= ', ' . $3;
			} else {
			    $header{$lastHeader}= $3;
			}
		    } else {
			die "incorrect input format: mail header line without colon: '$line'\n";
		    }
		}
	    }
	}
    } else {
	# are in body of mail - reading up to next From
	if ($line =~ /^From /) {
	    $staticReadOneMailFrom= $line; 
	    $end= (1==1);
	} else {
	    $body.= $line;
	}
    }
    $end= $end || eof($fh);
  }
  my $subject= 'Subject: ' . defined($header{'Subject'})?$header{'Subject'}:'no subject';
  my $fromP= 'From: ' . $header{'From'};
  my $to= 'To: ' . defined($header{'To'})?$header{'To'}:'';
  return ($body, $subject, $from, $fromP, $to, %header) ;
}

sub trim {
    my ($in)= @_;
    $in=~ s/^( *)(.*)$/$2/;
    $in=~ s/^(.*)( *)$/$1/;
    return $in;
}

0;