#!/usr/bin/perl
# bad-links.pl
# read the error list and create the error reports
# if the -s argument is specified, error reports are sent to individual users
#  via email


sub usage {
  die "usage: bad-links.pl <webserverdomainname> [<docroot>] [-s] <error.list >error.report

-s	send web error reports via email
";
}

# if this many errors occur during a one-minute interval then ignore
# all errors during that interval.  probably because a server was down.
$ERTYME_IGN  = 48;
$ERTYME_SHO  = 18;

$opt_s='';
$docroot='/www/data';			# default docroot
if ($#ARGV == 0) {
  $whost=$ARGV[0];
} elsif ($#ARGV == 1) {
  $whost=$ARGV[0];
  if ($ARGV[1] eq '-s') {
    $opt_s=1;
  } else {
    $docroot=$ARGV[1];
  }
} elsif ($#ARGV == 2) {
  $whost=$ARGV[0];
  $docroot=$ARGV[1];
  if ($ARGV[2] eq '-s') {
    $opt_s=1;
  } else {
    &usage;
  }
} else {
  &usage;
}

print STDERR "\ncreate web error reports for $whost\n";
die "bad-links: can't find docroot for $whost $docroot: $!\n" unless -d $docroot;

$| = 1;				# unbuffered output
$NRMAX=10;			# no more than nrmax-1 errors per file
$EXCEPT='/www/data/httpd/reports/except/elist';
$TEMP='/tmp/bad-links.tmp';
$ADMINUSER='';			# send root, www, radish, unknown reports here
$REPLYTO='webmaster@columbia.edu';
$ERRCOLUMN=58;

chop($SORT=`which sort`);
die("can't find sort\n") if $SORT =~ /^no /;

$MAILPROG='/usr/lib/sendmail';
die("$MAILPROG not found\n") unless -x $MAILPROG;

die "can't open dbm file $EXCEPT: $!\n"
	unless dbmopen(ELIST, $EXCEPT, 0640);

&write_temp_file;

&get_preamble;
$prev_group  = '';
$prev_user   = '';
$prev_req    = '';
$prev_url    = '';
$prev_ecode  = '';
$prev_ecount = '';
$mopen       = '';
$mailsent    = 0;

die "can't read $TEMP: $!\n" unless open(TEM, $TEMP);
while (<TEM>) {
    chop;
    ($group, $user, $person, $req, $url, $ecode, $ecount,
		$time1, $time2) = split /\t/;
    $ertyme{$time1}++;
}
close(TEM);

foreach $et (sort keys %ertyme) {
  if ($ertyme{$et} >= $ERTYME_IGN) {
    print "$ertyme{$et} errors at $et will be ignored\n";
  } elsif ($ertyme{$et} >= $ERTYME_SHO) {
    print "$ertyme{$et} errors at $et\n";
  }
}
die "can't sort $TEMP: $!\n" unless open(SOR, "$SORT $TEMP |");
while (<SOR>) {
    chop;
    ($group, $user, $person, $req, $url, $ecode, $ecount, $time1, $time2) = split /\t/;
    next if $ertyme{$time1} >= $ERTYME_IGN; # ignore errors at trouble time
    $time1=~s/:(\d\d:\d\d)$/ $1/;	# change colon to space
    $time2=~s/:(\d\d:\d\d)$/ $1/;	# between date and time
    if    ($group  ne $prev_group)	{ &new_group; }
    elsif ($user   ne $prev_user)	{ &new_user;  }
    elsif ($req    ne $prev_req)	{ &new_req;   }
    elsif ($url    ne $prev_url)	{ &new_url;   }
    else				{ &new_ecode; }

    $prev_group  = $group;
    $prev_user   = $user;
    $prev_req    = $req;
    $prev_url    = $url;
}
close(SOR);
unlink($TEMP);


if ($mopen) {
    close(MAIL);
    $mopen='';
}
print STDERR "$mailsent messages sent\n" if $mailsent;
dbmclose(ELIST);

########################################

sub write_temp_file {
# read the error file created by getstats.  here is a sample record:
# /acis/rad/index.html	/~beecher/99503.html	404	2	20/Dec/1997:11:36       20/Dec/1997:14:30

# lookup the user and group, creating the temp file
    local($fromcgi, $tocgi, $mailto, $badfile, $goodfile) = (0,0,0,0,0);
    if (!open(TMP, ">$TEMP")) {
	die "can't create $TEMP: $!\n";
    }
    while (<STDIN>) {
	chop;
	($req, $url, $rest) = split(/\t/, $_, 3);
	if (($req =~ m|^/cgi-bin|) ||		# ignore bad links from CGI
	    ($req =~ m|^/sec-cgi-bin|)) {
	  $fromcgi++;
	  next;
	}
	if (($url =~ m|^/cgi-bin|) ||		# ignore bad links to CGI
	    ($url =~ m|^/sec-cgi-bin|)) {
	  $tocgi++;
	  next;
	}
	if ($url =~ /mailto:/) {		# ignore links to mailto:
	  $mailto++;
	  next;
	}
	@fileinfo = stat("$docroot$req");	# stat the file
	$group    = 'Unknown';
	$user     = 'Unknown';
	$person   = 'Unknown';
	if ($fileinfo[1] &&			# file exists
	  ($fileinfo[4]!=-1)) {			# uid is not -1
	  @userinfo=getpwuid($fileinfo[4]);	# username and group
	  $user=$userinfo[0] if $userinfo[0];
	  $group=getgrgid($userinfo[3]);
	  $person = (split(',',$userinfo[6],2))[0];
	  $person =~ s/  / /g;
	  $person = 'Unknown' unless $person;

	  print TMP join("\t", $group, $user, $person, $req, $url, $rest)."\n";
	  $goodfile++;
	} else {
	  $badfile++;
	}
    }
    close(TMP);
    print STDERR "$fromcgi links from CGI files ignored\n" if $fromcgi;
    print STDERR "$tocgi links to CGI files ignored\n"     if $tocgi;
    print STDERR "$mailto mailto links ignored\n"          if $mailto;
    print STDERR "$badfile files not found\n"		   if $badfile;
    print STDERR "$goodfile files included in report\n";
}


sub new_group {
    print "\n\n-------- GROUP $group --------";
    &new_user;
}

sub new_user {
    local($muser);
    if ($mopen) {
	close(MAIL);
	$mopen='';
    }
    # suppress email sending if -s option was not specified
    # or the file belongs to root, radish, www, or unknown,
    # or the file owner has unsubscribed
    if (!$opt_s ||
	($user eq 'root') || ($user eq 'radish') || ($user eq 'www') ||
	($ELIST{$user} eq 'E')) {
	print "\n\nReport for $person <$user>\n";
	&new_req;
	return;
    }
    $muser=$user;
    print "\n\nSending mail to $person <$muser>\n";
    die("can't run $MAILPROG: $!\n")
		unless open(MAIL, "|$MAILPROG -t");
    $mopen=1;
    $mailsent++;
    print MAIL "To: $muser
Reply-To: $REPLYTO
Subject: web error report for $user
$preamble
      $whost error report for $person <$user>
";    
    &new_req;
}

sub new_req {
    local($request) = $req;
    $nrfail=0;
    $request =~ s/#.*//;
    print MAIL "\n$request\n" if $mopen;
    print "\n$request\n";
    &new_url;
}

sub new_url {
  return if ++$nrfail > $NRMAX;	# no more than nrmax-1 errors per file
  if ($nrfail == $NRMAX) {
    local($msg)= "     [...]\n";
    print MAIL $msg if $mopen;
    print $msg;
  } else {
    local($msg)= "     bad link to $url\n";
    print MAIL $msg if $mopen;
    print $msg;
    &new_ecode;
  }
}

sub new_ecode {
    local($errmsg);
    return if $nrfail > $NRMAX;
    if    ($ecode eq '400') { $errmsg='Bad syntax'; }
    elsif ($ecode eq '401') { $errmsg='Access denied'; }
    elsif ($ecode eq '403') { $errmsg='Protected'; }
    elsif ($ecode eq '404') { $errmsg='Not found'; }
    elsif ($ecode eq '405') { $errmsg='Method not allowed'; }
    elsif ($ecode eq '408') { $errmsg='Timeout'; }
    elsif ($ecode eq '500') { $errmsg='Server error'; }
    elsif ($ecode eq '501') { $errmsg='Not implemented'; }
    else                    { $errmsg=$errcode; }
    if ($ecount==1) {
	print MAIL "                  $errmsg at $time1\n" if $mopen;
	print      "                  $errmsg at $time1\n";
    } else {
	print MAIL "                  $errmsg [$ecount times] $time1 to $time2\n" if $mopen;
	print      "                  $errmsg [$ecount times] $time1 to $time2\n";
    }
}

sub get_preamble {		# this is the place for informative text
    $preamble="
      Web Server Error Report

The following error report is created each week from the failed
attempts in our web server access logs.  This information is provided
by AcIS as a service to providers of web documents on ColumbiaWeb.

The errors listed below were registered by the $whost
web server during the week ending this past Saturday.  Web errors can
sometimes indicate a broken link caused by a spelling mistake or
incorrect file protection.  They might be caused by a file server
outage, or system downtime.  They can also be a false alarm, generated
by faulty web browsers.

Questions about your files or about your web directory should be sent
to webmaster\@columbia.edu.

To unsubscribe:

If you no longer want to receive this weekly error report send mail
from your columbia email account to radish\@columbia.edu and specify
the following phrase as the subject of your message:
   unsubscribe web-error-report

";
}
