#!PERL -T
#
# Domtools CGI script
#
# If this script is named "nph-*", the Apache web server will flush partial output to
# the browser, so the user can see progress as it's working (instead of seeing a blank
# screen until the domain tool completely finishes).  Another good side-effect of this is
# for sites with a http proxy that times out after so many seconds; the occasional output
# helps hold open the connection until the domain tool completes.
#
# Copyright (C) 1993-1999 Paul A. Balyoz <pab@domtools.com>
#
require '../lib/cgi-lib.pl';

my($max_mins) = 10;			# Maximum number of minutes we will run before
					# we time-out ourselves.

my($max_sessions) = 4;			# Maximum simultaneous domtools sessions (users).
					# (set to 0 to disable)


my($ipaddr_bad) = 0;			# Bogus ip address from browser flag
my($domain_bad) = 0;			# Bogus domain name from browser flag
my($didhead) = 0;			# Flag turns on once we output Content-type, HEAD,
					# and just start BODY.
my($zone,$domain,$ipaddr);		# Working variables

#$DEBUG = 1;	# on (extra output)
$DEBUG = 0;	# off

#$FAKERUN = 1;	# use fake output file
$FAKERUN = 0;	# really run command live

$prog = "nph-domtools";		# our very own self

# Title of this web page
$title = "Domain Tool Output";

# Output text is colorized on the web page.
$black="#000000";
$white="#FFFFFF";
$red="#CC0000";
$purple="#6600FF";
$green="#009900";
$orange="#CC6600";

# Who to notify via email when we are installed wrong (Makefile fills this in)
$who = "ADMINUSER\@ADMINSITE";

# Path to good BSD-style mail program on your web server (Makefile fills this in)
$mail = "MAILPROG";

# Set a known path for security reasons
$ENV{'PATH'} = "/usr/local/bin/domtools:/usr/local/bin:/sbin:/usr/sbin:/bin:/usr/bin";

# Log file for transactions (Makefile fills this in)
chop($d = `pwd`);
if ($d =~ /^([A-Za-z0-9_\-\.\/]+)$/) {
	$logfile = "$1/../lib/domtoolscgi.log";
}
undef $d;

# --------------------------- END CONFIGURATIONS ------------------------------

# -------------------------- BEGIN TOOL CONFIGURATIONS -----------------------------

%table = (
#        ACTION             TAKES     TAKES   RECUR  TOOL(S) TO RUN
#        (lowercase)        DOMAIN?   IP?     FLAG?  (comma-separated)
	'siteinfo'    => [    1,        0,     0,    "siteinfo" ],
	'soa/domain'  => [    1,        0,     0,    "soa" ],		# and "rp" later on
	'mx'          => [    1,        0,     0,    "mx" ],
	'cname'       => [    1,        0,     0,    "cname" ],
	'soalist'     => [    1,        0,     0,    "soalist" ],
	'zone/domain' => [    1,        0,     0,    "zone" ],
	'subzone'     => [    1,        0,     0,    "subzone" ],
	'any'         => [    1,        0,     0,    "any" ],
	'ns'          => [    1,        0,     0,    "ns" ],
	'nsroot'      => [    1,        0,     0,    "nsroot" ],
	'hosts'       => [    1,        0,     1,    "hosts" ],

	'soa/ip'      => [    0,        1,     0,    "soa" ],		# and "rp" later on
	'zone/ip'     => [    0,        1,     0,    "zone" ],
	'netname'     => [    0,        1,     0,    "netname" ],
	'gw'          => [    0,        1,     0,    "gw" ],
	'ptr'         => [    0,        1,     0,    "ptr" ],
	'network'     => [    0,        1,     0,    "network" ],
	'netmask'     => [    0,        1,     0,    "netmask" ],
	'subnetmask'  => [    0,        1,     0,    "subnetmask" ],

	'gensubnetlist-wc'  => [ 0,     1,     0,    "gensubnetlist" ],
	'gensubnetlist'  => [ 0,        1,     0,    "gensubnetlist" ],
);
# NOTE: If both TAKES DOMAIN and TAKES IP are set, then _either_one_ may be given,
#       but if the user specifies both of them it is an error.
#       If RECUR FLAG is set then if "recursive=on" URL arg given, "-r" flag will be
#       passed to the tool when we launch it.

# Indexes to get pieces of the above arrays:
$domainelem = 0;
$ipelem = 1;
$recursiveelem = 2;
$toolelem = 3;

# --------------------------- END TOOL CONFIGURATIONS ------------------------------


# Check if there's too many other Domtools sessions right now
$counter = &check_session if $max_sessions;

chdir "/tmp";

# Set an alarm for so many minutes and abort at that time.
$SIG{ALRM} = "timeout_handler";
alarm ($max_mins * 60);

# sneaky way to indent text -- draw an invisible horizontal line!
# not all browsers are happy with this though.
$tab = "<IMG SRC=\"IMAGESURL/invispixel.gif\" BORDER=0 WIDTH=50 HEIGHT=1>";

# Read all args from URL or Unix command line (when testing)
&ReadParse(*input);

# no buffered output (so browser can slowly print as data is sent)
my($tmpfh) = select(STDOUT); $|=1; select($tmpfh);

# Validate environment: if stuff is missing, abort right away.
if (! -x "DOMTOOLSBIN/f2iaddr") {
	&notify ("$prog: DOMTOOLSBIN/f2iaddr is missing or not executable");
	&error ("installation error; webadmin notified.  Please try again later.");
}
elsif (! -x "DOMTOOLSBIN/zone") {
	&notify ("$prog: DOMTOOLSBIN/zone is missing or not executable");
	&error ("installation error; webadmin notified.  Please try again later.");
}

$DEBUG && print "survived checks\n";


#
# Parse URL arguments and handle errors
#

$action = "";
for (keys(%input)) {
	$name = lc((split (/\./,$_))[0]);	# ignore ".x" and ".y" extensions
	if (exists $table{$name}) {
		$action = $1 if $name =~ /^(.*)$/;			# pretend to untaint
		last;
	}
}
if ($action eq "") {
	&error("No tool specified or unknown tool; please choose again.");
	exit 0;
}

$domain = "";
if ($input{'domain'}) {
	if ($input{'domain'} =~ /^\s*([A-Za-z0-9_\-\.]+)\s*$/) {		# untaint
		$domain = $1;
	} else {
		&error("Domain names may only include characters A-Z a-z 0-9 _ - and .");
		exit 0;
	}

	# Did they specify an IP address by mistake?
	if (`DOMTOOLSBIN/type $domain 2>/dev/null` eq "forward\n") {
		&error("You specified an IP address, I was kind of hoping for a domain name.  Go back and try again.");
		exit 0;
	}

	$domain .= "." if $domain =~ /[^\.]$/;		# append dot if needed
}

$ip = "";
if ($input{'ip'}) {
	if ($input{'ip'} =~ /^\s*([0-9\.]+)\s*$/) {		# untaint
		$ip = $1;
	} else {
		&error("IP addresses may only include digits 0-9 and .");
		exit 0;
	}

	# Did they specify a domain name by mistake?
	if (`DOMTOOLSBIN/type $ip 2>/dev/null` eq "domain\n") {
		&error("You specified a domain name, I was kind of hoping for an IP address.  Go back and try again.");
		exit 0;
	}

	$ip =~ s/\.+$//;		# remove ending dot(s) if needed
}

$recursive = 0;
if ($input{'recursive'}) {
	if ($input{'recursive'} =~ /^on|yes|true$/i) {		# untaint
		$recursive = 1;
	}
	elsif ($input{'recursive'} =~ /^off|no|false$/i) {		# untaint
		$recursive = 0;
	}
	else {
		&error("'recursive' URL arg should be either 'on' or 'off'.  Try again.");
		exit 0;
	}
}

# Check if they specified the right args (domain and/or IP) based on the tool they specified.
if ($table{$action}[$domainelem]) {		# domain allowed
	if ($table{$action}[$ipelem]) {		# IP allowed
		if (!$domain && !$ip) {
			&error("This action requires either a domain name or an IP address, please go back and enter one.");
			exit 0;
		}
		elsif ($domain && $ip) {
			&error("This action requires either a domain name or an IP address, but not both.  Please go back and clear one.");
			exit 0;
		}
	}
	else {				# domain allowed but IP not allowed
		if (!$domain) {
			&error("This action requires a domain name, please go back and enter one.");
			exit 0;
		}
	# Don't be so grouchy
	#	elsif ($ip) {
	#		&error("This action requires a domain name not an IP address.  Please go back and enter one.");
	#		exit 0;
	#	}
	}
}
else {				# domain not allowed
	if ($table{$action}[$ipelem]) {		# IP allowed
		if (!$ip) {
			&error("This action requires an IP address, please go back and enter one.");
			exit 0;
		}
	# Don't be so grouchy
	#	elsif ($domain) {
	#		&error("This action requires an IP address not a domain name.  Please go back and enter one.");
	#		exit 0;
	#	}
	}
	else {			# neither domain nor IP allowed
	# Don't be so grouchy
	#	if ($domain || $ip) {
	#		&error("This action does not require a domain name or an IP address, please go back and clear them out.");
	#		exit 0;
	#	}
	}
}


#
# Special per-tool arg parsing
#

@cmdprefix = ();			# strings to print before real command string
					# (let the user know we did some extra steps)

# SOA, zone, ptr tools: if IP addr given, convert to an in-addr.arpa domain name first

if (($action eq "soa/ip" || $action eq "zone/ip" || $action eq "ptr") && $ip) {
	chop($d = `DOMTOOLSBIN/f2iaddr $ip 2>/dev/null`);
	if ($d eq "ERROR") {
		&notify ("$prog: running 'f2iaddr $ip' failed, please check on it.");
		&error("The web server encountered a problem with IP address conversion, the webadmin has been notified.  Please try again later.");
		exit 0;
	}
	if ($d =~ /^\s*([A-Za-z0-9_\-\.]+)\s*$/) {		# untaint
		$domain = $1;
	}
	die "misconfigured untaint" if $domain eq "";
	push @cmdprefix, "f2iaddr $ip";		# tell the user what we've done
	$ip = "";
}

# gw, netname, subnetmask tools: convert IP to a network number first

if ($table{$action}[$toolelem] =~ /^gw|netname|subnetmask$/) {
	chop($n = `DOMTOOLSBIN/network $ip 2>/dev/null`);
	if ($n ne "ERROR") {		# if error then skip this; keep going.
		if ($n =~ /^\s*([0-9\.]+)\s*$/) {		# untaint
			$netw = $1;
		}
		die "misconfigured untaint" if $netw eq "";
		if ($netw ne $ip) {		# if they're the same, we did nothing.
			push @cmdprefix, "network $ip";	# tell the user what we've done
			$ip = $netw;
		}
	}
}

# gensubnetlist needs 2 netmasks, as well as the IP address, to work.

if ($action eq "gensubnetlist-wc" || $action eq "gensubnetlist") {
	#
	# Get netmask (mask1) from URL args
	#
	$netmask = "";
	if ($input{'mask1'}) {
		if ($input{'mask1'} =~ /^\s*([0-9\.]+)\s*$/) {	# untaint
			$netmask = $1;
		} else {
			&error("Netmasks/numbers may only include digits 0-9 and .");
			exit 0;
		}

		# Did they specify a domain name by mistake?
		if (`DOMTOOLSBIN/type $netmask 2>/dev/null` eq "domain\n") {
			&error("You specified a domain name, I was kind of hoping for an IP address.  Go back and try again.");
			exit 0;
		}

		$netmask =~ s/\.+$//;		# remove ending dot(s) if needed
	}
	else {
		&error("This action requires a netmask to be specified (or you can specify an integer number of bits).");
		exit 0;
	}

	#
	# Get subnetmask (mask2) from URL args
	#
	$subnetmask = "";
	if ($input{'mask2'}) {
		if ($input{'mask2'} =~ /^\s*([0-9\.]+)\s*$/) {	# untaint
			$subnetmask = $1;
		} else {
			&error("Subnetmasks/numbers may only include digits 0-9 and .");
			exit 0;
		}

		# Did they specify a domain name by mistake?
		if (`DOMTOOLSBIN/type $subnetmask 2>/dev/null` eq "domain\n") {
			&error("You specified a domain name, I was kind of hoping for an IP address.  Go back and try again.");
			exit 0;
		}

		$subnetmask =~ s/\.+$//;		# remove ending dot(s) if needed
	}
	else {
		&error("This action requires a subnetmask to be specified (or you can specify an integer number of bits).");
		exit 0;
	}

	#
	# If they specified an IP, netmask, or subnetmask with less than 4 octets, run netwithzeros on them.
	#
	if (split(/\./,$ip) < 4) {
		push @cmdprefix, "netwithzeros $ip";
		chop($n = `DOMTOOLSBIN/netwithzeros $ip 2>/dev/null`);
		if ($n eq "ERROR") {
			&notify ("$prog: running 'netwithzeros $ip' failed, please check on it.");
			&error("The web server encountered a problem with IP address conversion, the webadmin has been notified.  Please try again later.");
			exit 0;
		}
		if ($n =~ /^\s*([0-9\.]+)\s*$/) {			# untaint
			$ip = $1;
		}
		die "misconfigured untaint" if $ip eq "";
	}
	if (split(/\./,$netmask) < 4) {
		push @cmdprefix, "netwithzeros $netmask";
		chop($n = `DOMTOOLSBIN/netwithzeros $netmask 2>/dev/null`);
		if ($n eq "ERROR") {
			&notify ("$prog: running 'netwithzeros $netmask' failed, please check on it.");
			&error("The web server encountered a problem with IP address conversion, the webadmin has been notified.  Please try again later.");
			exit 0;
		}
		if ($n =~ /^\s*([0-9\.]+)\s*$/) {			# untaint
			$netmask = $1;
		}
		die "misconfigured untaint" if $netmask eq "";
	}
	if (split(/\./,$subnetmask) < 4) {
		push @cmdprefix, "netwithzeros $subnetmask";
		chop($n = `DOMTOOLSBIN/netwithzeros $subnetmask 2>/dev/null`);
		if ($n eq "ERROR") {
			&notify ("$prog: running 'netwithzeros $subnetmask' failed, please check on it.");
			&error("The web server encountered a problem with IP address conversion, the webadmin has been notified.  Please try again later.");
			exit 0;
		}
		if ($n =~ /^\s*([0-9\.]+)\s*$/) {			# untaint
			$subnetmask = $1;
		}
		die "misconfigured untaint" if $subnetmask eq "";
	}
}


#
# Process request
#

&begin_html;
print "<P>Other sessions currently running on this server: $counter</P>\n" if $max_sessions;
$cmd = $table{$action}[$toolelem];	# official domtool command to launch
$cmd .= " -r" if ($table{$action}[$recursiveelem] && $recursive);
if ($domain) {
	$cmd .= " $domain";
} elsif ($ip) {
	$cmd .= " $ip";
}
if ($action eq "gensubnetlist-wc" || $action eq "gensubnetlist") {
	$cmd .= " $netmask $subnetmask";
}
#if ($action eq "gensubnetlist-wc") {
#	$cmd .= " | wc -l";
#}
&log("query by $ENV{'REMOTE_HOST'} [$ENV{'REMOTE_ADDR'}], $cmd");
print "<P></P><HR><P></P>\n";
&runtool($action,$cmd);
&end_html;

#
# End of program
#
exit 0;


# ----------------------------------- SUBROUTINES ---------------------------------------

#
# Begin the web page
#
sub begin_html {
	# If script is "nph-" style, we must generate all headers ourselves.
	# The advantage is that HTML output is flushed immediately to the browser!
	if ($0 =~ m:^(.*/)*nph-[^/]*$:) {
		print "HTTP/1.1 200 OK\015\012";
		print "Connection: close\015\012";
	}

	# Print regular HTML header now

	print "Content-type: text/html\n\n";
	print "<HTML>\n";
	print "<HEAD>\n";
	print "<TITLE>$title</TITLE>\n";
	print "</HEAD>\n\n";
	$didhead++;
	print "<BODY>\n";

	print "<CENTER><TABLE BORDER=0><TR><TD><IMG SRC=\"/images/domtools-icon.jpg\" BORDER=0 WIDTH=32 HEIGHT=32 ALIGN=\"absmiddle\"></TD><TD>\n";
	print "	<FONT SIZE=+2>&nbsp;$title&nbsp;</FONT>\n";
	print "	</TD><TD><IMG SRC=\"/images/domtools-icon.jpg\" BORDER=0 WIDTH=32 HEIGHT=32 ALIGN=\"absmiddle\"></TD></TR></TABLE></CENTER>\n";
	print "<P></P>\n";
}


#
# End the web page
#
sub end_html {
	print "<P></P>\n";

	if ($DEBUG) {
		print "<PRE>\n";
		for $k (sort(keys(%ENV))) {
			printf "%25s = %s<BR>", $k, $ENV{$k};
		}
		print "</PRE>\n";
	}

#	print "<HR>\n";
#	print "<P><A HREF=\"HTMLURL/\"><IMG SRC=\"IMAGESURL/left-arrow.gif\" BORDER=0 ALIGN=\"absmiddle\" WIDTH=79 HEIGHT=46> Back to the Domtools Web Page</A></P>\n";

	print "<HR>\n";
	print "<CENTER><FONT SIZE=-2>Domtools Web service brought to you by <A HREF=\"/~pab/\">Paul Balyoz</A>\
 &nbsp; &nbsp; Sponsored by <A HREF=\"/\">Domtools Consulting</A></FONT></CENTER>";
	print "</BODY>\n";
	print "</HTML>\n";
}


#
# Run the domtools command passed in.
# Output to stdout in html format.
#

sub runtool {
	my($action,$cmd) = @_;

	my($errors) = 0;
	my($warnings) = 0;
	my($s1,$s2);
	my(@output);
	my($saveoutput) = 0;
	my($nlines);

$DEBUG && print "runtool() called, about to open data file\n";
	if ($FAKERUN) {
		$cmd = "cat /tmp/out";
	}

	# Tell what command we're going to run
	print "Commands:\n";
	print "<BLOCKQUOTE>\n";
	print "    <FONT COLOR=$green><TT>";
	for (@cmdprefix) {				# print any pre-command commands we did
		print "$_<BR>\n";
	}
	if ($action eq "gensubnetlist-wc") {		# give the user the shell equivalent of
		print "$cmd | wc -l</TT></FONT>\n";	# what we're doing.
	} else {
		print "$cmd</TT></FONT>\n";
	}
	print "</BLOCKQUOTE>\n";

	print "Output:\n";
	print "<BLOCKQUOTE>\n";

	# Run command
	if (! (open (DATA, "$cmd 2>&1 |"))) {
		&notify ("$prog: launch of '$cmd' failed, please check on it.");
		&error ("runtime error with domtools; webadmin notified.  Please try again later.");
	}

	# no buffered output (so browser can slowly print as data is sent)
	my($tmpfh) = select(DATA); $|=1; select($tmpfh);

	print "    <PRE>\n";

	if ($table{$action}[$toolelem] eq "soa" || $action eq "gensubnetlist-wc") {
		$saveoutput = 1;			# parse _after_ all output read in.
	}
	# Read all output lines and generate HTML
	while (<DATA>) {
		s/&/&amp;/g;
		s/</&lt;/g;
		s/>/&gt;/g;
		s/"/&quot;/g;

		# Save action-specific output parsing for later
		if ($saveoutput) {
			push @output, $_;		# memorize the line
		} else {
			print;				# or print the line
		}
	}
	close DATA;

	# Do action-specific output parsing
	if ($saveoutput) {
		if ($table{$action}[$toolelem] eq "soa") {
			if ($?>>8 == 0) {		# (tweak output only if not an error message)
				for (@output) {
					$_ = (split)[1];		# email addr of zone's owner
					$_ =~ s/\./@/;			# replace first "." with"@"
					$_ =~ s/\.+$/\n/;		# remove ending periods too,
									#   replace them with a newline
				}
			}

		} elsif ($action eq "gensubnetlist-wc") {
			if ($?>>8 == 0) {		# (tweak output only if not an error message)
				for (@output) {
					$nlines = $#output + 1;
					@output = ("$nlines");
				}
			}
		}

		for (@output) {
			print;				# print all modified output
		}
	}

	print "    </PRE>\n";
	print "</BLOCKQUOTE>\n";
}


#
# Check how many other sessions are running; if over limit, boot user off.
#
sub check_session {
	my($counter) = 0;
	my($pid,@a);

	opendir (D,"/proc") || die "opendir /proc";
	foreach (readdir(D)) {
		next if ! /^\d+$/;		# only use file names with all-digits
		$pid = $_;

		if (open (F,"/proc/$pid/cmdline")) {	# open fails if process exited,
							# which we don't care about.
			$_ = scalar(<F>);
			close F;

			@a = split (/\000/);		# nul chars between args
			if ($a[0] =~ /perl/ && $a[1] =~ /nph-domtools/) {
				$counter++;		# add them up
			}
		}
	}
	closedir D;
	$counter--;				# don't count ourself in that!
	$counter = 0 if $counter < 0;		# remote chance this may happen

	if ($counter >= $max_sessions) {
		&begin_html;
		print "<P>Other sessions currently running on this server: $counter</P>\n";
		&log ("Maximum sessions reached ($counter sessions, $max_sessions max).");
		&error ("Maximum number of sessions reached ($max_sessions), please try again later.");
	}

	$counter;
}


#
# Notify web admin of a problem by sending him email.
#
sub notify {
	my ($msg) = @_;

	open (F, "| $mail -s '$prog misconfigured' $who") || die "$prog: cannot open pipe to $mail";
	print F "$prog is misconfigured, internal error occurred:\n";
	print F "    $msg\n";
	close F;
}


#
# Error occurred -- send the message as HTML back to the browser.
#
sub error {
	my ($msg) = @_;

	&begin_html if ! $didhead;

	print "<PRE>\n$msg\n</PRE>\n";

	&end_html;
	exit 0;
}


#
# Write 1 line to end of log file w/ time/date stamp.
#
sub log {
	my($msg) = @_;

	my($mo,$da,$yr,$hr,$mn,$sc);

	($sc,$mn,$hr,$da,$mo,$yr,$x) = localtime;
	$yr += 1900;				# 4-digit year please
	$mo++;					# 1=january

	open (LOG, ">>$logfile");		# don't bother checking for error
	printf LOG "%02d/%02d/%04d %02d:%02d:%02d %s\n", $mo, $da, $yr, $hr, $mn, $sc, $msg;
	close LOG;
}


#
# Abort program run in a nice way when alarm goes off.
#
sub timeout_handler {
	&begin_html if ! $didhead;

	print "\n</PRE>\n";
	print "<P>Web page time limit exceeded; domtools run aborted. Looks like you'll have to\n";
	print "<A HREF=\"/dns/domtools.shtml\">download Domtools for yourself</A>\n";
	print "to see the whole output for that query.</P>\n\n";

	&end_html;
	exit 0;
}
