#!/usr/bin/perl -Tw
#
#NAME
#  admin - Intercept and report calls
#
#SYNOPSIS
#  http://host.dom.ain:port/CGI/ae/...
#
#DESCRIPTION
#  This program writes info about who called it and what info they passed.
#  The most common name is "admin", because invocations of such a script
#  is commonly seen in web logs. The main problem is finding a portable
#  way to get info about the parent process, since the tools to do this
#  varies a lot from OS to OS.
#
#OPTIONS
#
#FILES
#
#BUGS
#
#SEE ALSO
#  This is really just a variant of the ae.cgi script, with output
#  going somewhere other than to the client.
#
#AUTHOR John Chambers <jc@trillian.mit.edu>
# Modified off and on, as we find other things that it's useful for.
# (You might consider this a "prototype" for such tools.)

$| = 1;
$V = 1;
#use strict;
$exitstat = -1;		# We normally "fail" ;-)
my($e, $n, @names, $query, $v, @vals);
my($botname, $hms, $msg, $UA, $ymd);
my($botpat) = 		# Pattern to recognize bots in UA
		'[-\w]*Google\w*|msnbot|BecomeBot|bingbot|Yahoo[-.\s\w]*|scirus-crawler';

#push @INC, '.';
#require "sendsubs.pm";

use CGI;
use CGI::Carp 'fatalsToBrowser';
use diagnostics;

print "Content-type: text/html\n\n";
print "<html>\n";
print "<head>\n";
print "\t<title>$0</title>\n" if $V>1;
print "\t<meta http-equiv='Content-Type' content='text/html;charset=utf-8' />\n" if $V>1;
print "\t<meta name='robots' content='index,nofollow'>\n" if $V>1;
print "\t<meta name=viewport content='width=device-width'>\n" if $V>1;
print "</head>\n";
print "<body>\n";
print "\t<center>\n" if $V>1;
print "\t\t$0\n" if $V>1;
print "\t</center>\n" if $V>1;
print "\t\n";

print "<hr>Here are our form elements:\n" if $V>1;
$query = new CGI;
@names = $query->param();
print "<dl compact>\n";
for $n (sort @names) {
	if (@vals = $query->param($n)) {
		for $v (@vals) {print "<dt>$n<dd>\"$v\"\n"}
	} elsif ($v = $query->param($n)) {
		print "<dt>$n<dd>\"$v\"\n";
	} else {
		print "<dt>$n<dd>(NO VALUE)\n";
	}
}
print "</dl>\n" if $V>1;

print "<hr>Here are our environment variables:\n" if $V>1;
print "<dl>\n" if $V>1;
for $e (sort keys %ENV) {
	$v = $ENV{$e};
	print "<dt>$e<dd>$v\n" if $V>1;
}
print "</dl>\n" if $V>1;

# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
# Check for known bots, and reject their request if they've asked for a  tune #
# match.   But we don't discriminate against them here; we just announce that #
# we think they're a bot.                                                     #
# - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - #
if ($UA = $query->param('HTTP_USER_AGENT')) {
	if ($UA =~ /$botpat/i) {
		$botname = $1;
		my($ss,$mm,$hh,$DD,$MM,$CY) = gmtime(time);
		$CY += 1900;
		$ymd = sprintf("%04d%02d%02d",$CY,1+$MM,$DD);	# CCYY-MM-DD
		$hms = sprintf("%02d%02d%02d",$hh,$mm,$ss);	# HH:MM:SS
		$msg = "[$ymd $hms] $$ $0: Request from \"$botname\" bot.";
		print STDERR "$msg\n";	# Tell the errlog about it
		print        "$msg\n" if $V>1;	# Tell the client about it
	}
}

print "</body>\n";
print "</html>\n";

exit $exitstat;