#!/usr/bin/perl --
use strict;
use vars qw! %actions %criteria %const @str %FORM @DataFields %system @sendmail %MimeType !;
(%actions, %criteria, %const, @str, %FORM, @DataFields, %system, @sendmail, %MimeType) = ();

$const{'PRINT_HTTP_STATUS_HEADER'} = 0;
my $VERSION = '2.0.0.0010';
my $all_code = "\n" x 8 . <<'END_OF_CODE';
my $err = '';
Err: {
	local $_;
	if (($0 =~ m!(.+)(\\|/)!) and ($0 !~ m!safeperl\d*$!i)) {
		my $dir = $1;
		unless (chdir($dir)) {
			$err = "unable to change directory to folder '$dir' - $!";
			next Err;
			}
		}

	delete $INC{'./ag-shared.txt'};
	require './ag-shared.txt';

	$err = &ag_init($VERSION);
	next Err if ($err);

	my $b_is_done = &admin_main();
	last Err if ($b_is_done);

	$err = &handle_error();
	next Err if ($err);

	last Err;
	}
continue {
	print "HTTP/1.0 200 OK\015\012" if ($const{'PRINT_HTTP_STATUS_HEADER'});
	print "Content-Type: text/html\015\012\015\012" unless ($const{'has_http_header'});
	&syslog($err);
	&ppstr(1,$err);
	}


sub admin_main {
	my $err = '';
	my $b_is_done = 1;
	Err: {

		print "HTTP/1.0 200 OK\015\012" if ($const{'PRINT_HTTP_STATUS_HEADER'});

		my $sa = $FORM{'sa'} || 'AP';

		if ($FORM{'fdrk_audit'}) {
			&regkey_verify();
			return 1;
			}

		my $b_is_logout = ($sa eq 'SO') ? 1 : 0;

		my $auth = ();
		($err, $auth) = &WebAuthEx(
			'make_starter_accounts' => 1,
			'data_folder' => '.',
			);
		next Err if ($err);
		my ($is_auth, $private_token, $auth_username, $is_cookies_aware, $is_initial_login, $html_out) = $auth->_WAX_Challenge( \%FORM, $b_is_logout );

		unless ($is_auth) {
			$sa = 'no-auth';
			}
		else {
			if ($sa eq 'sim') {
				foreach (keys %FORM) {
					if (m!^sim::(.+)$!) {
						$ENV{$1} = &he($FORM{$_});
						}
					}
				$ENV{'guardian_test'} = 1;
				return 0; #will failover to error-test
				}

			$const{'AdminForm'} = qq!<form method="post" action="$const{'admin_url'}">\n!;
			$const{'admin_url'} .= '?';

			unless ($is_cookies_aware) {
				$const{'admin_url'} .= 'web_auth_cp=' . $private_token . '&amp;';
				$const{'AdminForm'} .= '<input type="hidden" name="web_auth_cp" value="' . $private_token . '" />';
				}
			}

		if ($sa eq 'TCMP') {
			my $time = time();
			my $tgmt = &FormatDateTime( $time, 12, 1 );
			my $cmp = $tgmt . '.' . $time;
			$cmp =~ s!\D+!.!g;
			print "Location: http://www.xav.com/time.cgi?cmp=$cmp\015\012\015\012";
			last Err;
			}


		if ($sa eq 'ELD') {
			print qq!Content-Type: application/file_download\015\012!;
			print qq!Content-Disposition: attachment; filename="guardian.csv"\015\012\015\012!;
			print qq!time,human_time,visitor_hostname,visitor_ip,error_code,error_count,error_url,referring_url,user_agent,\015\012!;
			my $row_count;
			($err, $row_count) = &print_csv_format( $FORM{'sb'} || 0, $FORM{'cs'}, 0 );
			next Err if ($err);
			last Err;
			}



		print "Content-Type: text/html\015\012\015\012";
		print <<"EOM";
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
<html>
<head>
	<title>Guardian: Admin Page</title>
	<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" />
	<meta http-equiv="robots" content="none" />
	<style type="text/css">

		.completed {
			color:#000000;
			background-color:#dddddd;
			}
		a.acompleted,a.acompleted:visited,a.acompleted:hover {
			color:#cc0000;
			background-color:#dddddd;
			}
		.waiting {
			color:#dd0000;
			background-color:#ffffff;
			}
		.waitingtext {
			color:#cccccc;
			background-color:#ffffff;
			}

		body,div,p,td,th,tr,dl,dt,dd,input.submit {
			font-family:verdana,sans-serif;
			font-size:10pt;
			}
		th {
			color:#000000;
			background-color:#9eb3c7;
			}
		a.onblue,a.onblue:visited,a.onblue:hover {
			color:#cc0000;
			background-color:#9eb3c7;
			}
		.s {
			color:#000000;
			background-color:#d5d2bb;
			}
		.w {
			color:#000000;
			background-color:#ffffff;
			}
		hr {
			color:#9eb3c7;
			background-color:#ffffff;
			}
		input,textarea {
			font-family:monospace;
			font-size:10pt;
			}
		input.submit {
			color:#000000;
			background-color:#d5d2bb;
			font-weight:bold;
			}
		.err {
			color:#cc0000;
			background-color:#ffffff;
			}
		a,a:visited {
			color:#cc0000;
			background-color:#ffffff;
			}
		a:hover {
			color:#cccccc;
			background-color:#ffffff;
			}
	</style>
</head>
<body>
<center>
<table border="0" cellpadding="0" cellspacing="0" width="750">
<tr>
	<td align="right"><small>[ <a href="http://www.xav.com/scripts/guardian/" target="_blank">Guardian</a> v$VERSION is &copy; 2003 by Fluid Dynamics Software || <a href="$const{'help_file'}">Help</a> ]</small>
	</td>
</tr>
<tr>
	<td valign="top" align="left">
	<hr size="1" />

EOM

		$const{'has_http_header'} = 1;
		$const{'needs_html_footer'} = 1;


		my %linkmaster = (

			'iih' => "<a href=\"$const{'admin_url'}sa=iih\">IIS Install Help</a>",
			'zih' => "<a href=\"$const{'admin_url'}sa=zih\">Zeus Install Help</a>",
			'aih' => "<a href=\"$const{'admin_url'}sa=aih\">Apache Install Help</a>",

			'azc' => "<a href=\"$const{'admin_url'}sa=azc\">Update Access Control File</a>",
			'aac' => "<a href=\"$const{'admin_url'}sa=aac\">Update Access Control File</a>",

			'CsysL' => "<a href=\"$const{'admin_url'}sa=CsysL\">Clear System Errors</a>",
			'RsysL' => "<a href=\"$const{'admin_url'}sa=RsysL\">Review System Errors</a>",
			'AP' => "<a href=\"$const{'admin_url'}sa=AP\">Admin Page</a>",
			'MFR' => "<a href=\"$const{'admin_url'}sa=MFR\">Manage Filter Rules</a>",
			'MSS' => "<a href=\"$const{'admin_url'}sa=MSS\">$str[30]</a>",
			'UL' => "<a href=\"$const{'admin_url'}sa=UL\">Update License</a>",
			'LT' => "<a href=\"$const{'admin_url'}sa=LT\">Manage Templates</a>",
			'RL' => "<a href=\"$const{'admin_url'}sa=RL\">Review Log</a>",

			'EL' => "<a href=\"$const{'admin_url'}sa=EL\">Export Data</a>",

			'TEST' => "<a href=\"$const{'admin_url'}sa=TEST\">System Information and Testing</a>",
			);

		if ($sa eq 'no-auth') {
			print $html_out;
			last Err;
			}
		elsif ($sa eq 'MFR') {

			print "<p><b>$linkmaster{'AP'} &gt; $linkmaster{'MFR'} &gt; $str[27]</b></p>\n";

			my $file = 'filters_human.txt';

			#revcompat pre-0005 back when single file for both
			if ((not -e $file) and (-e 'filters.txt')) {
				$file = 'filters.txt';
				}
			#/revcompat

			my $text = '';
			($err, $text) = &ReadFile($file);
			next Err if ($err);

			$text =~ s!\# do not edit this data file - http://www.xav.com/scripts/guardian/help/1023.html\r?\n?!!s;

			my $html_text = &he($text);

print <<"EOM";

$const{'AdminForm'}
<input type="hidden" name="sa" value="SFR" />

<table border="0" cellpadding="4" cellspacing="1">
<tr>
	<td class="s"><textarea name="rules" rows="20" cols="85">$html_text</textarea></td>
</tr>
</table>

<blockquote>
	<p><input type="submit" class="submit" value="Save Data" /></p>
</blockquote>

</form>

EOM
			($err, $text) = &ReadFile( $system{'language'} . '/filters.html' );
			next Err if ($err);
			print $text;
			last Err;
			}
		elsif ($sa eq 'SFR') {
			print "<p><b>$linkmaster{'AP'} &gt; $linkmaster{'MFR'} &gt; Save Data</b></p>\n";

		if ($const{'mode'} == 0) {
			$err = "unable to save settings in the online demo";
			next Err;
			}

			my $tight = '';
			foreach (split(m!\015|\012!s, $FORM{'rules'})) {
				$_ = &Trim($_);
				next unless ($_); # skip null, whitespace
				next if (m!^\s*\#!); # skip comments
				$tight .= "$_\015\012";
				}
			# remove leading, trailing delims
			$tight =~ s!^==\015\012!!os;
			$tight =~ s!==\015\012$!!os;


			# okay is this valid stuff?

			my %ac = (
				'case-match' => 1,
				'trailer' => 1,
				'any' => 1,
				'error-code' => 1,
				'url-pattern' => 1,
				'url-substring' => 1,
				'url-string' => 1,
				'refer-pattern' => 1,
				'refer-substring' => 1,
				'refer-string' => 1,
				'ua-pattern' => 1,
				'ua-substring' => 1,
				'ua-string' => 1,
				);

			my %rc = (
				'blacklist' => 2,
				'dos' => 2,
				'error-template' => 1,
				'http-redirect' => 2,
				'http-redirect-temp' => 2,
				'ignore' => 1,
				'redirect' => 2,
				'replace' => 2,
				);


			my %criteria_seen = ();

			my $b_match_any = 0;

			my ($rules, $warnings, $errors) = (0, 0, 0);

			my $out = '';
			my $final_rules = '';


			my $b_zeus = (&query_env('SERVER_SOFTWARE') =~ m!zeus!i) ? 1 : 0;

			Rule: foreach (split(m!==!s, $tight)) {
				$_ = &Trim($_);
				unless (m!^(.+?)\:\s*(.+?)\015\012(.+?):\s*(.+)$!s) {
					$out .= "<pre>" . &he($_) . "</pre>\n";
					$out .= &pstr(1, "this Filter Rule does not pattern match to \"action:str&lt;newline&gt;reaction:str\". This rule will be ignored");
					$errors++;
					next Rule;
					}
				my ($a, $as, $response) = (lc($1), $2, "$3: $4");

				$out .= "<pre>" . &he($_) . "</pre>\n";


				# audit criteria portion:

				unless (defined($ac{$a})) {
					$out .= &pstr(1, "action '". &he($a) . "' is not valid");
					$errors++;
					next;
					}
				if ($a =~ m!-pattern!) {
					# oh... they're trying to regex... we'll see about that...s
					my $temp_err = &check_regex($as);
					if ($temp_err) {
						$out .= &pstr(1,$temp_err);
						$errors++;
						next;
						}
					}
				if (($a eq 'error-code') and ($as !~ m!^\d\d\d$!)) {
					$out .= &pstr(1, "the action string for 'error-code' rules must be a 3-digit integer" );
					$errors++;
					next;
					}

				my ($r_inactive, $r_active) = ('', '');

				# audit response portion (possibly multi-line)
				my $active_reaction_count = 0;
				foreach (split(m!\015\012!s, $response)) {
					unless (m!^(.+?):\s+(.*?)$!s) {
						$out .= &pstr(1, "reaction block '$_' does not match 'reaction: string' pattern" );
						next Rule;
						}
					my ($r, $rs) = (lc($1), $2);
					unless (defined($rc{$r})) {
						$out .= &pstr(1, "reaction '". &he($r) . "' is not valid");
						$errors++;
						next Rule;
						}
					if (($const{'mode'} == 3) and (2 == $rc{$r})) {
						$out .= &pstr(2, qq!reaction '$r' cannot be used in <a href="$const{'admin_url'}sa=UL">Freeware mode</a>. This rule will be ignored during runtime! );
						$warnings++;
						}
					if (($r =~ m!^(ignore|dos)$!) and ($rs !~ m!^\d+$!)) {
						$out .= &pstr(1, "reaction string for '$r' must be an integer" );
						$errors++;
						next Rule;
						}
					if (($r =~ m!^(blacklist|replace)$!) and (not (-e $rs))) {

						if ($rs =~ m!\$\d!) {
							$out .= &pstr( 2, "file '" . &he($rs) . "' was not found. If you are using runtime substitutions for file lookups, be sure that your non-variable portion is sufficiently detailed to avoid security holes" );
							$warnings++;
							}
						else {
							$out .= &pstr(1, "reaction string for '$1' must be an existing file; file '" . &he($rs) . "' was not found" );
							$errors++;
							next Rule;
							}
						}
					if ($r eq 'blacklist') {
						my $size = -s $rs || 0;
						my $max = &max_htaccess_size();
						if ($size > $max) {
							$out .= &pstr( 2, "file '" . &he($rs) . "' is size $size bytes.  This software will not append to .htaccess files which are larger than $max bytes" );
							$warnings++;
							}
						}

					if (($r eq 'error-template') and (not ((-e "$system{'language'}/$rs") or (-e $rs)))) {
						$out .= &pstr(1, "reaction string for '$r' must be an existing file; file '" . &he($rs) . "' was not found" );
						$errors++;
						next Rule;
						}

					if (($b_zeus) and ($r =~ m!^(dos|replace)$!)) {
						$out .= &pstr( 1, qq!reaction string '$r' is not supported on the Zeus web server (<a href="$const{'help_file'}1016.html" target="_blank">help</a>); rule will be disabled! );
						$errors++;
						next Rule;
						}

					if ($r =~ m!^(ignore|blacklist)$!) {
						$r_inactive .= "$r: $rs\015\012";
						}
					elsif (($b_zeus) and ($r =~ m!^http-redirect!)) {
						$active_reaction_count++;
						$r_active .= "redirect: $rs\015\012";
						$out .= &pstr( 2, qq!reaction type '$r' is not supported on the Zeus web server (<a href="$const{'help_file'}1016.html" target="_blank">help</a>); the 'redirect' rule will be used instead! );
						$warnings++;
						}
					else {
						$active_reaction_count++;
						$r_active .= "$r: $rs\015\012";
						}
					}
				if ($active_reaction_count > 1) {
					$out .= &pstr(1, "multi-line reaction block contains more than one reaction. Multi-line blocks can contain at most one active reaction, along with the special 'ignore' or 'blacklist' reactions" );
					$errors++;
					next Rule;
					}

				if ($b_match_any) {
					$out .= &pstr(2, "this filter rule will never take effect because the 'any' rule has already been declared. Filters are applied in the order in which they appear" );
					$warnings++;
					}
				$b_match_any = 1 if (($a eq 'any') and ($active_reaction_count));


				my $cri = "$a $as";
				if ($criteria_seen{$cri}) {
					my $x = &he($cri);
					$out .= &pstr(2, "this filter rule will never take effect because there is already a filter set up to act on criteria '$x'. Filters are applied in the order in which they appear" );
					$warnings++;
					}
				$criteria_seen{$cri} = 1 unless ($active_reaction_count == 0);


				$rules++;
				$out .= "<p><b>Success:</b> saved valid Filter Rule:</p>\n";
				$final_rules .= "$a: $as\015\012$r_inactive$r_active==\015\012";
				}
			continue {
				$out .= '<hr size="1" />';
				}

			unless ($b_match_any) {
				$out .= &pstr(2, "there is no active 'any' catch-all filter. You should declare one to avoid system errors" );
				$warnings++;
				}

			print qq!<p>Saved <b>$rules</b> rules. There were <b>$warnings</b> warnings and <b>$errors</b> errors.</p><hr size="1" />\n!;
			print $out;

			$final_rules =~ s!==\015\012$!!s;

			my $header = "# do not edit this data file - http://www.xav.com/scripts/guardian/help/1023.html\r\n";
			$err = &WriteFile( 'filters.txt', $header . "==\n" . $final_rules );
			next Err if ($err);
			&setchmod( 'filters.txt' );

			$err = &WriteFile( 'filters_human.txt', $header . $FORM{'rules'} );
			next Err if ($err);
			&setchmod( 'filters_human.txt' );

			print "<p><b>Success:</b> saved new filter rules.</p>\n";
			last Err;

			}




		elsif ($sa eq 'del_selected_errors') {
			print "<p><b>$linkmaster{'AP'} &gt; $linkmaster{'RL'} &gt; $str[24]</b></p>\n";


			my $delcount = 0;
			unless (open(FILE, "<errors.log")) {
				$err = "unable to open file 'errors.log' - $!";
				next Err;
				}
			binmode(FILE);
			unless (open(NEW, ">errors.log.temp")) {
				$err = "unable to write to file 'errors.log.temp' - $!";
				next Err;
				}
			binmode(NEW);
			my $line = 0;
			while (defined($_ = <FILE>)) {
				next unless (m!^(\d+)\t!);
				$line++;
				my $time = $1;
				if ($FORM{'del_' . $time . '_' . $line}) {
					$delcount++;
					}
				else {
					unless (print NEW $_) {
						$err = "error while writing to file 'errors.log.temp' - $!";
						close(FILE);
						close(NEW);
						unlink('errors.log.temp');
						next Err;
						}
					}
				}
			close(FILE);
			unless (close(NEW)) {
				$err = "unable to close filehandle for file 'errors.log.temp' - $!";
				unlink('errors.log.temp');
				next Err;
				}
			if ($delcount) {
				unlink('errors.log.bak');
				rename('errors.log','errors.log.bak');
				rename('errors.log.temp','errors.log');
				unlink('errors.log.bak');
				}
			else {
				unlink('errors.log.temp');
				$err = "no records matched for deletion";
				next Err;
				}

			print "<p><b>Success:</b> deleted $delcount records.</p>\n";
			last Err;
			}

		elsif ($sa eq 'del_sys_selected') {
			print "<p><b>$linkmaster{'AP'} &gt; $linkmaster{'TEST'} &gt; $linkmaster{'RsysL'} &gt; $str[24]</b></p>\n";
			if ((not $FORM{'max_sys_lines'}) or ($FORM{'max_sys_lines'} !~ m!^\d+$!)) {
				$err = "invalid argument - required parameter 'max_sys_lines' is missing";
				next Err;
				}
			my $delcount = 0;
			unless (open(FILE, "<syslog")) {
				$err = "unable to open file 'syslog' - $!";
				next Err;
				}
			binmode(FILE);
			unless (open(NEW, ">syslog.temp")) {
				$err = "unable to write to file 'syslog.temp' - $!";
				next Err;
				}
			binmode(NEW);
			my $line = 0;
			while (defined($_ = <FILE>)) {
				next unless (m!^(\d+),(.*?)\r?\n?$!);
				$line++;
				my $time = $1;
				my $revline = $FORM{'max_sys_lines'} - $line;
				if ($FORM{'del_' . $time . '_' . $revline}) {
					$delcount++;
					}
				else {
					unless (print NEW $_) {
						$err = "error while writing to file 'syslog.temp' - $!";
						close(FILE);
						close(NEW);
						unlink('syslog.temp');
						next Err;
						}
					}
				}
			close(FILE);
			unless (close(NEW)) {
				$err = "unable to close filehandle for file 'syslog.temp' - $!";
				unlink('syslog.temp');
				next Err;
				}
			if ($delcount) {
				unlink('syslog.bak');
				rename('syslog','syslog.bak');
				rename('syslog.temp','syslog');
				unlink('syslog.bak');
				}
			else {
				unlink('syslog.temp');
				$err = "no records matched for deletion";
				next Err;
				}

			print "<p><b>Success:</b> deleted $delcount records.</p>\n";
			last Err;
			}

		elsif ($sa eq 'CsysL') {
			print "<p><b>$linkmaster{'AP'} &gt; $linkmaster{'TEST'} &gt; $linkmaster{'RsysL'} &gt; Clear Log</b></p>\n";
			if ($FORM{'confirm'}) {
				$err = &WriteFile( 'syslog', '' );
				next Err if ($err);
				&setchmod( 'syslog' );
				print "<p><b>Success:</b> cleared log of system errors.</p>\n";
				last Err;
				}

print <<"EOM";
$const{'AdminForm'}
<input type="hidden" name="sa" value="CsysL" />
<p><b>You must check the checkbox below to confirm.</b></p>
<p><input type="checkbox" name="confirm" value="1" id="confirm_1" /><label for="confirm_1"> To delete the log of all system errors, click this checkbox and then click on "$str[23]".</label></p>
<p><input type="submit" class="submit" value="$str[23]" /></p>
</form>
EOM
			last Err;
			}
		elsif ($sa eq 'RsysL') {
			print "<p><b>$linkmaster{'AP'} &gt; $linkmaster{'TEST'} &gt; $linkmaster{'RsysL'} &gt; $str[27]</b></p>\n";

print <<"EOM";

<p>Below is a list of all errors encounter by Guardian itself.</p>

$const{'AdminForm'}
<input type="hidden" name="sa" value="CsysL" />
<p><input type="checkbox" name="confirm" value="1" id="confirm_1" /><label for="confirm_1"> To delete the log of all system errors, click this checkbox and then click on "$str[23]".</label></p>
<p><input type="submit" class="submit" value="$str[23]" /></p>
</form>





EOM



			ShowLog: {
				unless (-s 'syslog') {
					print "<p>The system log is empty. No system errors have been recorded.</p>\n";
					last ShowLog;
					}

				unless (open(FILE, "<syslog")) {
					$err = "unable to open file 'syslog' - $!";
					next Err;
					}
				binmode(FILE);
print <<"EOM";

</div></center>
<br />
<center>

$const{'AdminForm'}
<input type="hidden" name="sa" value="del_sys_selected" />

<table border="1" cellpadding="4" cellspacing="0" width="100%">
<tr>
	<th><br /></th>
	<th nowrap="nowrap">Year-M-D HH:M:S<br />Time</th>
	<th nowrap="nowrap">Error</th>
</tr>

EOM

				my $i = 0;
				foreach (reverse(<FILE>)) {
					next unless (m!^(\d+),(.*?)\r?\n?$!);
					my ($humantime, $time, $err) = (&FormatDateTime($1,12), $1, &he(&url_decode($2)));

					my $str_ago = &get_age_str( time() - $time );

					print qq!<tr><td align="center"><input type="checkbox" name="del_${time}_${i}" value="1" id="d$i" /></td><td nowrap="nowrap" align="center">$humantime<br />$str_ago</td><td align="left">Error: $err.</td></tr>\n!;

					$i++;
					}


				print <<"EOM";

</table>

<input type="hidden" name="max_sys_lines" value="$i" />

<p align="left"><input type="submit" class="submit" value="$str[24]" />

<script type="text/javascript">
<!--
function SetAll(state) {
	var max = $i;
	for (var i = 0; i < max; i++) {
		if ((document) && (document.all) && (document.all("r" + i))) {
			document.all("r" + i).checked = state;
			}
		}
	}
if ((document) && (document.all) && (document.all("r0"))) {
	document.write( '<a href="javascript:SetAll(true)">check all</a> - <a href="javascript:SetAll(false);">clear all</a>' );
	}

//-->
</script>


</p>

</form>

</center><br /><center><div style="width:750px; align:center; text-align:left">

EOM

				print "<p>Displayed total of $i error records.</p>\n";

				last ShowLog;

				}
			last Err;
			}






		elsif ($sa eq 'CL') {
			print "<p><b>$linkmaster{'AP'} &gt; $linkmaster{'RL'} &gt; Clear Log</b></p>\n";
			if ($FORM{'confirm'}) {
				unless (open(FILE, ">errors.log")) {
					$err = "unable to write to file 'errors.log' - $!";
					next Err;
					}
				print FILE '';
				close(FILE);
				&setchmod( 'errors.log' );
				print "<p><b>Success:</b> cleared log file.</p>\n";
				last Err;
				}
print <<"EOM";
$const{'AdminForm'}
<input type="hidden" name="sa" value="CL" />
<p><b>You must check the checkbox below to confirm.</b></p>
<p><input type="checkbox" name="confirm" value="1" id="confirm_1" /><label for="confirm_1"> To delete all existing records in the log file, click this checkbox and then click on "$str[23]".</label></p>
<p><input type="submit" class="submit" value="$str[23]" /></p>
</form>
EOM
			last Err;
			}


		elsif ($sa eq 'EL') {

			my $sortf = $FORM{'sb'} || 0;

			print "<p><b>$linkmaster{'AP'} &gt; $linkmaster{'RL'} &gt; $linkmaster{'EL'}</b></p>\n";

			unless (-s 'errors.log') {
				print "<p>The log is empty; there are no errors on file.</p>\n";
				last Err;
				}

			my %records = ();
			unless (open(FILE, "<errors.log")) {
				$err = "unable to open file 'errors.log' - $!";
				next Err;
				}
			binmode(FILE);
			while (defined($_ = <FILE>)) {
				my @fields = split(m!\t!s);
				$records{ $fields[$sortf] . $_ } = $_;
				}
			close(FILE);

			my $cs = $sortf;
			if ((defined($FORM{'cs'})) and ($FORM{'cs'} == $sortf)) {
				$cs = 99;
				}

print <<"EOM";
<p><textarea name="export" rows="20" cols="90" wrap="off">time,human_time,visitor_hostname,visitor_ip,error_code,error_count,error_url,referring_url,user_agent,
EOM


			my $row_count;
			($err, $row_count) = &print_csv_format( $FORM{'sb'} || 0, $FORM{'cs'}, 1 );
			next Err if ($err);

print <<"EOM";
</textarea></p>

<p>There are <b>$row_count</b> records listed above.</p>

EOM


			last Err;
			}

		elsif ($sa eq 'detail') {

			if ((not $FORM{'line'}) or ($FORM{'line'} !~ m!^\d+$!)) {
				$err = "invalid argument - required parameter 'line' not present or invalid";
				next Err;
				}

			print qq!<p><b>$linkmaster{'AP'} &gt; $linkmaster{'RL'} &gt; <a href="$const{'admin_url'}sa=detail&amp;line=$FORM{'line'}">Line $FORM{'line'}</a></b></p>\n!;

			unless (open(FILE, "<errors.log")) {
				$err = "unable to open file 'errors.log' - $!";
				next Err;
				}
			binmode(FILE);
			my @fields = ();
			my $line = 0;
			while (defined($_ = <FILE>)) {
				$line++;
				next unless ($line == $FORM{'line'});
				@fields = &he(split(m!\t!s,$_));
				last;
				}
			close(FILE);
			unless (@fields) {
				$err = "unable to lookup line $FORM{'line'} - searched $line lines of file 'errors.log' to EOF";
				next Err;
				}

			my $htime = &FormatDateTime( $fields[0], 12 );

print <<"EOM";

<p>Details of error $FORM{'line'}.</p>

<table border="1" cellpadding="4" cellspacing="1">
<tr>
	<td align="right"><b>Time:</b></td>
	<td>$htime ($fields[0])</td>
</tr>
<tr>
	<td align="right"><b>Remote Host:</b></td>
	<td>$fields[2]<br /></td>
</tr>
<tr>
	<td align="right"><b>Remote Addr:</b></td>
	<td>$fields[3]<br /></td>
</tr>
<tr>
	<td align="right"><b>Referring URL:</b></td>
	<td>$fields[4]<br /></td>
</tr>
<tr>
	<td align="right"><b>Error URL:</b></td>
	<td>$fields[5]<br /></td>
</tr>
<tr>
	<td align="right"><b>Error Code:</b></td>
	<td>$fields[6]<br /></td>
</tr>
<tr>
	<td align="right"><b>Error Count:</b></td>
	<td>$fields[7]<br /></td>
</tr>
<tr>
	<td align="right"><b>User Agent:</b></td>
	<td>$fields[8]<br /></td>
</tr>
<tr>
	<td align="right"><b>HTTP_VIA:</b></td>
	<td>$fields[9]<br /></td>
</tr>
</table>

EOM


			last Err;
			}


		elsif ($sa eq 'RL') {


			print "<p><b>$linkmaster{'AP'} &gt; $linkmaster{'RL'} &gt; $str[27]</b></p>\n";

			unless (-s 'errors.log') {
				print "<p>The log is empty; there are no errors on file.</p>\n";
				last Err;
				}

			my $sortf = $FORM{'sb'} || 0;

			my %records = ();
			unless (open(FILE, "<errors.log")) {
				$err = "unable to open file 'errors.log' - $!";
				next Err;
				}
			binmode(FILE);
			my $line = 0;
			while (defined($_ = <FILE>)) {
				$line++;
				my @fields = split(m!\t!s);
				$records{ $fields[$sortf] . "\t" . $line . "\t" . $_ } = $line . "\t" . $_;
				}
			close(FILE);

			my $cs = $sortf;
			if ((defined($FORM{'cs'})) and ($FORM{'cs'} == $sortf)) {
				$cs = 99;
				}

print <<"EOM";

<hr size="1" />

$const{'AdminForm'}
<input type="hidden" name="sa" value="CL" />
<p><input type="checkbox" name="confirm" value="1" id="confirm_1" /><label for="confirm_1"> To delete all existing records in the log file, click this checkbox and then click on "$str[23]".</label></p>
<p><input type="submit" class="submit" value="$str[23]" /></p>
</form>

<hr size="1" />

<p><b>Data Export</b></p>

<p>Click here for a selectable <a href="$const{'admin_url'}sa=EL&amp;sb=$sortf&amp;cs=$cs">CSV-formatted version of this table</a>, for export into a spreadsheet program.</p>

<p>Click here for a downloadable <a href="$const{'admin_url'}sa=ELD&amp;sb=$sortf&amp;cs=$cs" target="_blank">CSV version of this table</a>. Use your browser's special "Save File As" or "Save Target As" option when following the link.</p>

<hr size="1" />

	</td>
</tr>
</table>

<br />

<p align="left">Here are all the errors that have been recorded. You may click on one of the header fields to sort the log. To view the full details for a record, click on the time value. To selectively delete records, click the checkbox on the right and then submit the "Delete Checked Items" bottom of the of the page.</p>

$const{'AdminForm'}
<input type="hidden" name="sa" value="del_selected_errors" />

<table border="1" cellpadding="4" cellspacing="0" width="100%">
<tr>
	<th><br /></th>
	<th nowrap="nowrap"><a href="$const{'admin_url'}sa=RL&amp;sb=0&amp;cs=$cs" class="onblue">Year-M-D HH:M:S</a><br />Time</th>
	<th nowrap="nowrap"><a href="$const{'admin_url'}sa=RL&amp;sb=2&amp;cs=$cs" class="onblue">Visitor Hostname</a><br />
		<a href="$const{'admin_url'}sa=RL&amp;sb=3&amp;cs=$cs" class="onblue">IP Address</a></th>
	<th nowrap="nowrap"><a href="$const{'admin_url'}sa=RL&amp;sb=6&amp;cs=$cs" class="onblue">Error</a><br />
		<a href="$const{'admin_url'}sa=RL&amp;sb=7&amp;cs=$cs" class="onblue">Count</a></th>
	<th nowrap="nowrap"><a href="$const{'admin_url'}sa=RL&amp;sb=5&amp;cs=$cs" class="onblue">Error URL</a><br />
	<a href="$const{'admin_url'}sa=RL&amp;sb=4&amp;cs=$cs" class="onblue">Referring URL</a></th>
	<th nowrap="nowrap"><a href="$const{'admin_url'}sa=RL&amp;sb=8&amp;cs=$cs" class="onblue">User Agent</a></th>
</tr>

EOM


			my $i = 0;

			my ($b_limits, $u_limits, $h_limits) = (0, 0, 0);

			my @keys = ();

			# numeric sorts
			if (($sortf == 0) or ($sortf == 7) or ($sortf == 6)) {
				if ((defined($FORM{'cs'})) and ($FORM{'cs'} == $sortf)) {
					@keys = sort {$a <=> $b} keys %records;
					}
				else {
					@keys = reverse sort {$a <=> $b} keys %records;
					}
				}
			else {
				if ((defined($FORM{'cs'})) and ($FORM{'cs'} == $sortf)) {
					@keys = sort keys %records;
					}
				else {
					@keys = reverse sort keys %records;
					}
				}

			my $key;
			foreach $key (@keys) {
				# batch HTML-encode everything:
				local $_ = &he($records{$key});

				$i++;

				my ($line, @fields) = split(m!\t!, $_);
				my %hash = ();

				my $x = 0;
				for ($x = 0; $x < $#DataFields; $x++) {
					$hash{ $DataFields[$x] } = $fields[$x];
					}


				if (0 == ($i % $system{'RecordsPerBatch'})) {
					print qq!</table><br /><table border="1" cellpadding="4" cellspacing="0" width="100%">\n!;
					}

				$hash{'HTTP_REFERER'} = 'n/a' unless ($hash{'HTTP_REFERER'});

				my $field = '';
				foreach $field ('HTTP_REFERER', 'AG_ERROR_URL') {
					$hash{$field} =~ s!^http://!!o;
					if (($system{'MaxChar_url'}) and (length($hash{$field}) > $system{'MaxChar_url'})) {
						$hash{$field} = substr( $hash{$field}, 0, $system{'MaxChar_url'});
						$u_limits++;
						}
					}

				if (($system{'MaxChar_hostname'}) and (length($hash{'REMOTE_HOST'}) > $system{'MaxChar_hostname'})) {
					$hash{'REMOTE_HOST'} = substr( $hash{'REMOTE_HOST'}, 0, $system{'MaxChar_hostname'});
					$h_limits++;
					}

				if (($system{'MaxChar_browser'}) and (length($hash{'HTTP_USER_AGENT'}) > $system{'MaxChar_browser'})) {
					$hash{'HTTP_USER_AGENT'} = substr( $hash{'HTTP_USER_AGENT'}, 0, $system{'MaxChar_browser'});
					$b_limits++;
					}

				my $str_ago = &get_age_str( time() - $hash{'TIME'} );

print <<"EOM";

<tr>
	<td align="center"><input type="checkbox" name="del_$hash{'TIME'}_$line" value="1" id="r$i" /></td>
	<td align="center" nowrap="nowrap"><a href="$const{'admin_url'}sa=detail&amp;line=$line">$hash{'LOCALTIME'}</a><br />$str_ago</td>
	<td align="left" nowrap="nowrap">$hash{'REMOTE_HOST'}<br />$hash{'REMOTE_ADDR'}</td>
	<td align="right">$hash{'AG_ERROR_CODE'}<br />$hash{'AG_ERROR_COUNT'}</td>
	<td align="left" nowrap="nowrap">$hash{'AG_ERROR_URL'}<br />$hash{'HTTP_REFERER'}</td>
	<td align="left" nowrap="nowrap">$hash{'HTTP_USER_AGENT'}<br /></td>
</tr>


EOM

				}

print <<"EOM";

</table>

<p align="left"><input type="submit" class="submit" value="$str[24]" />

<script type="text/javascript">
<!--
function SetAll(state) {
	var max = $i;
	for (var i = 1; i <= max; i++) {
		if ((document) && (document.all) && (document.all("r" + i))) {
			document.all("r" + i).checked = state;
			}
		}
	}
if ((document) && (document.all) && (document.all("r1"))) {
	document.write( '<a href="javascript:SetAll(true)">check all</a> - <a href="javascript:SetAll(false);">clear all</a>' );
	}

//-->
</script></p>

</form>

<table border="0" width="750">
<tr>
	<td align="left">

		<p><br /></p>

		<p>Displayed total of $i error records.</p>

EOM

			my $logsize = -s 'errors.log';
			if ($system{'MaxLogBytes'}) {
				my $percent = int( 100 * $logsize / $system{'MaxLogBytes'} );
				print "<p>Log file 'errors.log' uses $logsize bytes of $system{'MaxLogBytes'} allowed ($percent%).</p>\n";
				}


			if ($system{'MaxChar_hostname'}) {
				print "<p>The display of visitor Hostname strings is limited to $system{'MaxChar_hostname'} characters. A total $h_limits strings were truncated.</p>\n";
				}
			if ($system{'MaxChar_url'}) {
				print "<p>The display of URL strings is limited to $system{'MaxChar_url'} characters. A total $u_limits strings were truncated.</p>\n";
				}
			if ($system{'MaxChar_browser'}) {
				print "<p>The display of User Agent strings is limited to $system{'MaxChar_browser'} characters. A total $b_limits strings were truncated.</p>\n";
				}

			print qq!<p>See "<a href="$const{'admin_url'}sa=MSS">Manage System Settings</a>" =&gt; "Logging Display" to control the limits for log size and displayed strings.</p>!;


			last Err;
			}
		elsif ($sa eq 'LT') {
			print "<p><b>$linkmaster{'AP'} &gt; $linkmaster{'LT'} &gt; $str[27]</b></p>\n";

			my @Files = ();
			unless (opendir(DIR, $system{'language'})) {
				$err = "unable to open folder '$system{'language'}' - $!";
				next Err;
				}
			foreach (sort readdir(DIR)) {
				next unless (m!\.txt$!);
				push(@Files, &he($_));
				}
			closedir(DIR);

print <<"EOM";

<p>Below are the current template files. Click on the file name to edit.</p>

<hr size="1" />

<p>This is the master template which controls the format of all error messages. Customize this template to control the colors, styles, table widths, header and footer text, and so on.</p>

<ul>

	<li>

		<p><a href="$const{'admin_url'}sa=ET&amp;file=template.txt">template.txt</a></p>

	</li>

</ul>

<hr size="1" />

<p>These are the individual error messages. Each of these templates is rendered independently, and then inserted within the master "template.txt" template for final display.</p>

<ul>

EOM

			foreach (@Files) {
				next if (m!^(template|strings|email_message|moved)\.txt$!);
				print qq!<li><p><a href="$const{'admin_url'}sa=ET&amp;file=$_">$_</a></p></li>\n!;
				}


print <<"EOM";

</ul>

<p>Guardian uses the "error-template" Filter Rules to invoke the these template files. Filter Rules provide the "glue" that maps an error condition to a specific error message. A basic example rule is:</p>

<pre>	error-code: 403
	error-template: error_403.txt</pre>

<p>You can create additional template files and then set up special Filter Rules to trigger them. For example, to have a special error message displayed for errors in your /test/ folder, you would create a special template file called "error_404_test.txt" and then set up Filter Rule like:</p>

<pre>	url-substring: /test/
	error-template: error_404_test.txt</pre>

<p>The $linkmaster{'MFR'} page discusses this in more detail.</p>

<hr size="1" />

<p>This is a stand-alone template file used to redirect visitors to other places.</p>

<ul>

	<li>

		<p><a href="$const{'admin_url'}sa=ET&amp;file=moved.txt">moved.txt</a></p>

	</li>

</ul>

<hr size="1" />

<p>This is the message sent to the administrator when email notification is enabled.</p>

<ul>

	<li>

		<p><a href="$const{'admin_url'}sa=ET&amp;file=email_message.txt">email_message.txt</a></p>

	</li>

</ul>

<hr size="1" />

<p>This file contains many of the strings used throughout the program. You may customize it, but it will be overwritten whenever you upgrade to the next version of Guardian, so you should always keep a separate copy of your customizations.</p>

<ul>

	<li>

		<p><a href="$const{'admin_url'}sa=ET&amp;file=strings.txt">strings.txt</a></p>

	</li>

</ul>

<hr size="1" />

$const{'AdminForm'}
<input type="hidden" name="sa" value="ET" />
<input type="hidden" name="is-new" value="1" />

<p>New template: <input name="file" /> <input type="submit" class="submit" value="Create File" /></p>

<p>Template file names can have only alphanumeric characters, and must end in ".txt".</p>

</form>

EOM

			last Err;
			}

		elsif ($sa eq 'ET') {

			my $file = $FORM{'file'};
			my $hfile = &he($file);

			print "<p><b>$linkmaster{'AP'} &gt; $linkmaster{'LT'} &gt; <a href=\"$const{'admin_url'}sa=ET&amp;file=$hfile\">$hfile</a></b></p>\n";

			# only a-z, _, 0-9, .

			my $temp_file = $file;
			$temp_file =~ s![A-Z|a-z|0-9|_|\.]!!g;
			if (length($temp_file)) {
				$err = "file name '" . &he($file) . "' contains forbidden characters '" . &he($temp_file) . "'";
				next Err;
				}

			if ($file !~ m!\.txt$!) {
				$err = "file name '$hfile' does not end in '.txt'";
				next Err;
				}

			my $text = '';
			if ((not (-e "$system{'language'}/$file")) and ($FORM{'is-new'})) {
				#blank okay
				}
			else {
				($err, $text) = &ReadFile( "$system{'language'}/$file" );
				next Err if ($err);
				}

			my %defaults = (
				'text' => $text,
				'file' => $file,
				);

print &SetDefaults(<<"EOM", \%defaults);

$const{'AdminForm'}
<input type="hidden" name="sa" value="ST" />
<input type="hidden" name="file" />

<p>Below are the contents of the $hfile template file:</p>

<table border="1" cellpadding="4" cellspacing="1">
<tr>
	<td class="s"><textarea name="text" rows="20" cols="85"></textarea></td>
</tr>
</table>

<blockquote>
	<p><input type="submit" class="submit" value="Save Data" /></p>
</blockquote>

</form>

<p><br /></p>

EOM

			if ($file eq 'strings.txt') {
				print '<p>The strings.txt file uses named strings like $s1 and $s2 for variable interpolation. It does not support the variable replacement rules that the other templates have.</p>';
				last Err;
				}

print <<"EOM";

<p><b>Variables for Use in All Templates</b></p>

<table border="1" cellpadding="4" cellspacing="1">
<tr>
	<td valign="top">%ErrorCode%</td>
	<td valign="top">The HTTP status code of the error. Example "404".</td>
</tr>
<tr>
	<td valign="top">%ErrorDescription%</td>
	<td valign="top">The descriptive string associated with the HTTP error code. Example "Not Found" for error code 404.</td>
</tr>
<tr>
	<td valign="top">%ErrorURL%</td>
	<td valign="top">The fully-qualified URL that experienced the error. Example "http://xav.com/".</td>
</tr>
<tr>
	<td valign="top">%ErrorCount%</td>
	<td valign="top">An integer count of how many times the visitor has caused this error code. Count information is stored in a session cookie on the client's browser and may not be incremented for clients which are not cookies-aware.</td>
</tr>
<tr>
	<td valign="top">%VERSION%</td>
	<td valign="top">The version of Guardian software, ex "2.0.0.0007".</td>
</tr>
<tr>
	<td valign="top">%copyright%</td>
	<td valign="top">An HTML block containing the Guardian copyright banner, link, and version information.</td>
</tr>
<tr>
	<td valign="top">%email_address%</td>
	<td valign="top">The administrator email address, as entered on the Manage System Settings page.</td>
</tr>
<tr>
	<td valign="top">%TimeStamp%</td>
	<td valign="top">A human-readable string expressing the time that the error occured.</td>
</tr>
<tr>
	<td valign="top">%RemoteHost%</td>
	<td valign="top">The visitor IP address (or reverse DNS, if available). Examples would be "12.225.156.208" or "12-225-156-208.client.attbi.com".</td>
</tr>
<tr>
	<td valign="top" nowrap="nowrap">%login_error_username%</td>
	<td valign="top">The username with which the visitor was attempting to log in, or which had already been used to log in, as provided by the REMOTE_USER environment variable. This variable is not available from all servers. Useful to help pro-actively contact customers who are having trouble logging in to secure areas.</td>
</tr>
<tr>
	<td valign="top">%HTTP_REFERER%</td>
	<td valign="top">The referring URL that led to the error. Useful for tracking down which web pages might be linking to outdated files on your site.</td>
</tr>
<tr>
	<td valign="top">%full_admin_url%</td>
	<td valign="top">The URL to the Guardian admin page.</td>
</tr>
<tr>
	<td valign="top">%SERVER_NAME%</td>
	<td valign="top">The SERVER_NAME environment variable.</td>
</tr>
<tr>
	<td valign="top">%script_path%</td>
	<td valign="top">The physical file path to the error-handler script; quoted from Perl's \$0 internal variable.</td>
</tr>
<tr>
	<td valign="top">%ENV_VARS%</td>
	<td valign="top">A clump of all environment variables with their values.</td>
</tr>
</table>

<p><br /></p>

<p><b>Variables for Use in Some Templates</b></p>

<table border="1" cellpadding="4" cellspacing="0">
<tr>
	<td valign="top">%specific_message%</td>
	<td valign="top">An HTML block containing the output of the error-specific template. The error-specific message is embedded within the master "template.txt" template for consistent display.<br /><i>Only available to the template.txt template.</i></td>
</tr>
<tr>
	<td valign="top">%URL%</td>
	<td valign="top">The URL to which the visitor is being redirected.<br /><i>Only available to the moved.txt template.</i></td>
</tr>
<tr>
	<td valign="top" nowrap="nowrap">%error_handling_description%</td>
	<td valign="top">A sentence or two written by Guardian which describes the error-handling steps that were taken in response to the error.<br /><i>Only available to the email_message.txt template.</i></td>
</tr>
<tr>
	<td valign="top">%rule%</td>
	<td valign="top">The text of the filter rule which handled the error; lists only the complete filter rule which took action, not any partial rules like "ignore" or "blacklist" which took partial action.<br /><i>Only available to the email_message.txt template.</i></td>
</tr>
</table>

<p><br /></p>

<p><b>Using Guardian Template Files</b></p>

<p>Simple variable replacements can be included by just embedding the variable:</p>

<pre>"You just experienced error code %ErrorCode%."</pre>

<p>Conditional statements can be made using "if" and "end if" tags:</p>

<pre>&lt;% if HTTP_REFERER %&gt;
	You linked in from %HTTP_REFERER%. There must be an invalid link there.
&lt;% end if %&gt;
&lt;% if not HTTP_REFERER %&gt;
	You did not link in from anywhere. How did you find this link?
&lt;% end if %&gt;</pre>

<p>Valid conditional forms are:</p>

<p>&lt;% if VARIABLE %&gt;</p>

<p>&lt;% if not VARIABLE %&gt;</p>

<p>&lt;% unless VARIABLE %&gt;</p>

<p>"unless" is an alias for "if not". All conditional blocks must be terminated by "&lt;% end if %&gt;". Note that, unfortunately, conditionals cannot be nested.</p>

<p>Simple include statements may be used in the templates, ala &lt;!--#include virtual="/header.txt" --&gt;.</p>

<p>Some simple SSI statements may be used in the templates, ala &lt;!--#echo var="DATE_LOCAL" --&gt;.</p>

<p>See <a href="$const{'help_file'}1024.html">using server-side includes</a> for more details.</p>

<p><br /></p>

EOM


			last Err;
			}
		elsif ($sa eq 'ST') {

			my $file = $FORM{'file'};
			my $hfile = &he($file);

			print "<p><b>$linkmaster{'AP'} &gt; $linkmaster{'LT'} &gt; <a href=\"$const{'admin_url'}sa=ET&amp;file=$hfile\">$hfile</a> &gt; Save Data</b></p>\n";

			# only a-z, _, 0-9, .

			my $temp_file = $file;
			$temp_file =~ s![A-Z|a-z|0-9|_|\.]!!g;
			if (length($temp_file)) {
				$err = "file name '" . &he($file) . "' contains forbidden characters '" . &he($temp_file) . "'";
				next Err;
				}
			if ($file !~ m!\.txt$!) {
				$err = "file name '" . &he($file) . "' does not end in '.txt'";
				next Err;
				}

			if ($const{'mode'} == 0) {
				$err = "unable to save settings in the online demo";
				next Err;
				}


			my $text = $FORM{'text'} || '';
			&force_CRLF(\$text);

			$err = &WriteFile( "$system{'language'}/$file", $text );
			next Err if ($err);
			&setchmod( "$system{'language'}/$file" );

print <<"EOM";

<p><b>Success:</b> saved data.</p>

<p>Click here to <a href="$const{'admin_url'}sa=ET&amp;file=$hfile">continue editing</a> the template file $hfile.</p>

<p>Click here to <a href="$const{'admin_url'}sa=LT">return to the list</a> of all template files.</p>

EOM



			last Err;
			}



		elsif ($sa eq 'MSS') {
			print "<p><b>$linkmaster{'AP'} &gt; $linkmaster{'MSS'} &gt; $str[27]</b></p>\n";

			# What is my local path?

			my $base_url = '';
			my ($temp_err,$clean_url, $host, $port, $path) = &parse_url_ex(&get_absolute_url());
			unless ($temp_err) {
				$base_url = $clean_url;
				$base_url =~ s!$path$!!o;
				$system{'base_url'} = $base_url unless ($system{'base_url'});
				}


			my $base_ex = '';
			if ($ENV{'DOCUMENT_ROOT'}) {
				$base_ex = &query_env('DOCUMENT_ROOT');

				#netfirms correction:
				if (($base_ex =~ m!^/mnt/web_\w/\w\d+/\w\d+/\w\d+\w\d+$!) and (-d "$base_ex/www")) {
					$base_ex .= "/www";

					}
				#virtualave corr:
				if (($base_ex eq '/home') and (-d "/home/public_html")) {
					$base_ex = "/home/public_html";
					}

				}
			else {
				my $forwardpath = $0;
				$forwardpath =~ s!\\!/!g;
				my $qmsn = quotemeta($ENV{'SCRIPT_NAME'} || '');
				if ($forwardpath =~ m!^(.*)$qmsn!i) {
					$base_ex = $1;
					}
				}
			if ((-e $base_ex) and (not ($system{'base_folder'}))) {
				$system{'base_folder'} = $base_ex;
				}




			my $sendmail_options = '';
			foreach (sort @sendmail) {
				next unless (m!^(\S+)!);
				next unless (-e $1);
				$sendmail_options .= '<option value="' . &he($_) . '">' . &he($_) . '</option>';
				}


			my $language_options = '';
			unless (opendir(DIR, '.')) {
				$err = "unable to open folder '.' - $!";
				next Err;
				}
			foreach (sort readdir(DIR)) {
				next if (m!^\.\.?$!);
				my $f = $_;
				next unless (-d $f);
				next unless (m!^[a-z]{2,3}$!);
				next unless (-e "$f/strings.txt");

				$language_options .= '<option value="' . &he($_) . '">' . &he($_) . '</option>';
				}

			my $auto_sec_mode = detect_sec_mode();

			my $test_option = '';
			if (
					($system{'email_address'})
					and
					(($system{'smtp_server'}) or ($system{'sendmail_program'}))
				) {
				$test_option = qq!<p>Click here to <a href="$const{'admin_url'}sa=testmsg">send a test message</a>.</p>!;
				}


print &SetDefaults(<<"EOM", \%system);

$const{'AdminForm'}
<input type="hidden" name="sa" value="SSS" />

<table border="0" cellpadding="4" cellspacing="1">
<tr>
	<th colspan="2">Email Settings</th>
	<td><br /></td>
</tr>
<tr>
	<td class="s" width="30%" align="right"><b>Email Address:</b></td>
	<td class="s" width="30%"><input name="email_address" /></td>
	<td><br /></td>
</tr>
<tr>
	<td class="s" align="right"><b>SMTP Server:</b></td>
	<td class="s"><input name="smtp_server" /></td>
	<td><br /></td>
</tr>
<tr>
	<td class="s" align="right"><b>Sendmail Program:</b></td>
	<td class="s"><select name="sendmail_program"><option value="">[ None ]</option>$sendmail_options</select></td>
	<td><br /></td>
</tr>
<tr>
	<td><br /></td>
	<td><input type="submit" class="submit" value="Save Data" /></td>
	<td><br /></td>
</tr>
<tr>
	<td colspan="3">
		<p><br /></p>

		<p>Click here for <a href="$const{'help_file'}1084.html">help</a> on configuring email in Guardian.  <b>SMTP Server</b> is the Internet server that has been assigned to deliver mail for your <b>Email Address</b>. You may use <a href="http://www.xav.com/mx_lookup.pl" target="_blank">this form</a> to lookup the server that has been assigned to your address.</p>

		$test_option

		<p><br /></p>

	</td>
</tr>
<tr>
	<th colspan="2">Miscellaneous</th>
	<td><br /></td>
</tr>
<tr>
	<td class="s" align="right"><b>Language:</b></td>
	<td class="s"><select name="language">$language_options</select></td>
	<td><br /></td>
</tr>
<tr>
	<td class="s" align="right"><b>Base URL:</b></td>
	<td class="s"><input name="base_url" size="32" /></td>
	<td><br /></td>
</tr>
<tr>
	<td class="s" align="right"><b>Base Folder:</b></td>
	<td class="s"><input name="base_folder" size="32" /></td>
	<td><br /></td>
</tr>
<tr>
	<td><br /></td>
	<td><input type="submit" class="submit" value="Save Data" /></td>
	<td><br /></td>
</tr>
<tr>
	<td colspan="3">

		<p><br /></p>

		<p>The <b>Base Folder</b> and <b>Base URL</b> values must be populated so that Guardian can evaluate "trailer" and "case-match" rules. The base variables should point to the root folder of the web site.</p>

		<p><br /></p>

	</td>
</tr>
<tr>
	<th colspan="2">File Permissions</th>
	<td><br /></td>
</tr>
<tr>
	<td class="s" valign="top" align="left">&nbsp; &nbsp; <input type="radio" name="sec_mode" value="0" id="sec_mode_0" /><label for="sec_mode_0"> <b>Auto-Detect</b></label><br /><br /></td>
	<td class="s" valign="top">Auto-detects the most secure permissions to use; recommended.</td>
	<td><br /></td>
</tr>
<tr>
	<td class="s" valign="top" align="left">&nbsp; &nbsp; <input type="radio" name="sec_mode" value="1" id="sec_mode_1" /><label for="sec_mode_1"> <b>1. None</b></label><br /><br /></td>
	<td class="s" valign="top">No permissions set. For Windows or other systems without chmod.</td>
	<td><br /></td>
</tr>
<tr>
	<td class="s" valign="top" align="left">&nbsp; &nbsp; <input type="radio" name="sec_mode" value="2" id="sec_mode_2" /><label for="sec_mode_2"> <b>2. Restrictive</b></label></td>
	<td class="s" valign="top">sets owner-write permissions of 600; use for suexec systems</td>
	<td><br /></td>
</tr>
<tr>
	<td class="s" valign="top" align="left">&nbsp; &nbsp; <input type="radio" name="sec_mode" value="3" id="sec_mode_3" /><label for="sec_mode_3"> <b>3. Permissive</b></label></td>
	<td class="s" valign="top">sets world-write permissions of 666; use for default systems</td>
	<td><br /></td>
</tr>
<tr>
	<td class="s" valign="top" align="left">&nbsp; &nbsp; <input type="radio" name="sec_mode" value="4" id="sec_mode_4" /><label for="sec_mode_4"> <b>4. Custom</b></label></td>
	<td class="s" valign="top">all files given <input name="sec_data_file" size="3" maxlength="3" /> permissions (ex: 666)</td>
	<td><br /></td>
</tr>
<tr>
	<td><br /></td>
	<td><input type="submit" class="submit" value="Save Data" /></td>
	<td><br /></td>
</tr>
<tr>
	<td colspan="3">

		<p><br /></p>

		<p>The <b>File Permissions</b> settings are used to control how permissions are set on the data files that Guardian creates (errors.log, filters.txt, etc.). It is best to choose <b>Auto-Detect</b>. The auto-detect algorithm currently selects option <b>$auto_sec_mode</b>.</p>

		<p><br /></p>

	</td>
</tr>
<tr>
	<th colspan="2">Logging Display</th>
	<td><br /></td>
</tr>
<tr>
	<td class="s" align="right"><b>Records per Batch:</b></td>
	<td class="s"><input name="RecordsPerBatch" size="8" /> <font color="#888888">recommended: 100</font></td>
	<td><br /></td>
</tr>
<tr>
	<td class="s" align="right"><b>Maximum Log Size:</b></td>
	<td class="s"><input name="MaxLogBytes" size="8" /> <font color="#888888">recommended: 1000000</font></td>
	<td><br /></td>
</tr>
<tr>
	<td class="s" align="right"><b>Perform DNS Lookups:</b></td>
	<td class="s"><input type="checkbox" name="dns_lookup" value="1" /></td>
	<td><br /></td>
</tr>
<tr>
	<th colspan="2">Maximum Displayed Characters per Field</th>
	<td><br /></td>
</tr>
<tr>
	<td class="s" align="right"><b>Hostname:</b></td>
	<td class="s"><input name="MaxChar_hostname" size="8" /> <font color="#888888">recommended: 24</font></td>
	<td><br /></td>
</tr>
<tr>
	<td class="s" align="right"><b>URL:</b></td>
	<td class="s"><input name="MaxChar_url" size="8" /> <font color="#888888">recommended: 72</font></td>
	<td><br /></td>
</tr>
<tr>
	<td class="s" align="right"><b>Browser:</b></td>
	<td class="s"><input name="MaxChar_browser" size="8" /> <font color="#888888">recommended: 48</font></td>
	<td><br /></td>
</tr>
<tr>
	<td><br /></td>
	<td><input type="submit" class="submit" value="Save Data" /></td>
	<td><br /></td>
</tr>
<tr>
	<td colspan="3">

		<p><br /></p>

		<p><b>Records per Batch</b> refers to the number of output records to be included in each table on the "Review Log" page. A lower number improves rendering time; a higher number improves visual continuity.</p>

		<p><b>Maximum Log Size</b> is the maximum allow size, in bytes, for the log file. The default value of 1000000 will limit you to a 1MB log. Useful for preventing disk space overload on busy unattended sites. Set the variable to 0 to allow any file size.</p>

		<p><b>Perform DNS Lookups</b> will cause Guardian to resolve all visitor IP addresses to their reverse-DNS values while logging (for example, it would resolve "204.127.198.4" to "ns1.attbi.com" and then save both values to the log). Having reverse-DNS values makes the logs and error reports more useful, but it also slows down the server. Because of the slowdown, it is disabled by default.</p>

		<p><b>Max Displayed Chars</b> limits the number of characters displayed in each field on the "Review Log" page. This prevents an occasional extremely long data field from offsetting the table. Set the values to 0 to remove all limitations.</p>

		<p>Recommendations are based on a screen resolution of 1280 x 1024.</p>

		<p><br /></p>

	</td>
</tr>
<tr>
	<th colspan="2">Update Password</th>
	<td><br /></td>
</tr>
<tr>
	<td class="s" align="right"><b>Current Password:</b></td>
	<td class="s"><input name="CP" type="password" /></td>
	<td><br /></td>
</tr>
<tr>
	<td class="s" align="right"><b>New Password:</b></td>
	<td class="s"><input name="NP1" type="password" /></td>
	<td><br /></td>
</tr>
<tr>
	<td class="s" align="right"><b>Confirm New:</b></td>
	<td class="s"><input name="NP2" type="password" /></td>
	<td><br /></td>
</tr>
<tr>
	<td><br /></td>
	<td><input type="submit" class="submit" value="Save Data" /></td>
	<td><br /></td>
</tr>
</table>

</form>



EOM



			last Err;
			}

		if ($sa eq 'UL') { # update license

print &SetDefaults(<<"EOM", \%system);

<p><b>$linkmaster{'AP'} &gt; $linkmaster{'UL'} &gt; Overview</b></p>

$const{'AdminForm'}
<input type="hidden" name="sa" value="ULS" />

<table border="1" cellpadding="4" cellspacing="1" width="300">
<tr>
	<th align="left"><input type="radio" name="mode" value="3" id="mode_3" /><label for="mode_3"> Freeware Mode</label></th>
</tr>
</table>

<ul>
	<li>Allows logging errors to file and the display of custom error messages.</li>
	<li>No per-error email notification.</li>
	<li>No advanced error handling rules.</li>
	<li>Must display copyright notice on error pages.</li>
</ul>

<p><br /></p>


<table border="1" cellpadding="4" cellspacing="1" width="300">
<tr>
	<th align="left"><input type="radio" name="mode" value="1" id="mode_1" /><label for="mode_1"> Trial Shareware</label></th>
</tr>
</table>

<ul>
	<li>Allows logging errors to file and the display of custom error messages.</li>
	<li>Per-error email notification.</li>
	<li>Allows use of advanced Filter Rules: replace, redirect, http-redirect, dos, blacklist</li>
	<li>Must display copyright notice on error pages.</li>
	<li>This mode can only be used for a limited time while testing the product.</li>
</ul>

<p><br /></p>



<table border="1" cellpadding="4" cellspacing="1" width="300">
<tr>
	<th align="left"><input type="radio" name="mode" value="2" id="mode_2" /><label for="mode_2"> Registered</label></th>
</tr>
</table>


<ul>
	<li>Allows logging errors to file and the display of custom error messages.</li>
	<li>Per-error email notification.</li>
	<li>Allows use of advanced Filter Rules: replace, redirect, http-redirect, dos, blacklist</li>
	<li>User can remove the copyright notice on error pages.</li>
</ul>

<p>Thanks to the strong support of our user community, the Guardian script is able to provide fast, reliable error handling for thousands of sites and millions of visitors. Guardian demonstrates that quality software is important to our community of web designers and administrators. If you find this software useful on your site, then please do your part to support it today.</p>

<p>Your support is immediately invested back into the product in the form of bug fixes and added features. By acquiring a license once, you will be allowed to use all future maintenance releases for free. To acquire a registration key, visit <a href="http://www.xav.com/scripts/guardian/purchase.html" target="_blank">www.xav.com/scripts/guardian</a>.</p>

<p>Enter your registration key below to enable the Registered Shareware mode:</p>
<p><textarea name="RegKey" rows="6" cols="60"></textarea></p>

<blockquote>

	<p><input type="submit" class="submit" value="Save Data" /></p>

</blockquote>

</form>

EOM

			last Err;
			}
		if ($sa eq 'ULS') {
			print "<p><b>$linkmaster{'AP'} &gt; $linkmaster{'UL'} &gt; Save Data</b></p>\n";
			if (($FORM{'RegKey'}) and (not $system{'RegKey'})) {
				$FORM{'mode'} = 2; #kick registered version if this is first input of key
				}
			foreach ('RegKey','mode') {
				if ($system{$_} ne $FORM{$_}) {
					print "<p><b>Status:</b> setting '$_' to $FORM{$_}.</p>\n";
					$system{$_} = defined($FORM{$_}) ? $FORM{$_} : '';
					}
				}
			$err = &validate_system_settings(1);
			next Err if ($err);

			$err = &save_system_settings();
			next Err if ($err);
			print "<p><b>Success:</b> registration information.</p>\n";
			last Err;
			}


		if ($sa eq 'SSS') {
			print "<p><b>$linkmaster{'AP'} &gt; $linkmaster{'MSS'} &gt; Save Data</b></p>\n";

			if (($FORM{'RegKey'}) and (not $system{'RegKey'})) {
				$FORM{'mode'} = 2; #kick registered version if this is first input of key
				}


			if (($system{'email_address'} ne $FORM{'email_address'}) and ($FORM{'email_address'}) and ($FORM{'email_address'} =~ m!.+\@.+\..+!)) {
				print "<p><b>Update Notification:</b> click <a href=\"http://www.xav.com/notify/?action=join&" . "amp;m=$FORM{'email_address'}&" . "amp;JoinList_Guardian=on\" target=\"_blank\">here to add yourself</a> to the Guardian mailing list for notification of security updates and new versions ($FORM{'email_address'}).</p>\n";
				}

			$FORM{'dns_lookup'} = $FORM{'dns_lookup'} ? 1 : 0;

			foreach ('email_address','smtp_server','sendmail_program','language', 'RecordsPerBatch','MaxLogBytes','MaxChar_hostname', 'MaxChar_browser', 'MaxChar_url', 'base_url','base_folder', 'sec_mode', 'sec_data_file', 'dns_lookup') {

				if ($system{$_} ne $FORM{$_}) {
					print "<p><b>Status:</b> setting '$_' to $FORM{$_}.</p>\n";
					$system{$_} = defined($FORM{$_}) ? $FORM{$_} : '';
					}
				}

			$err = &validate_system_settings(1);
			next Err if ($err);

			$err = &save_system_settings();
			next Err if ($err);
			print "<p><b>Success:</b> saved system settings.</p>\n";


			if (($const{'mode'}) and ($FORM{'CP'}) and ($FORM{'NP1'}) and ($FORM{'NP2'})) {
				$err = $auth->_WAX_UpdatePassword( 'webmaster', $FORM{'CP'}, $FORM{'NP1'}, $FORM{'NP2'} );
				next Err if ($err);
				print "<p><b>Success:</b> updated password.</p>\n";
				}


			last Err;
			}



		if ($sa eq 'aac') {
			$FORM{'server'} = 'Apache';
			$FORM{'self'} = 'aac';
			$sa = 'uacf';
			}

		if ($sa eq 'azc') {
			$FORM{'server'} = 'Zeus';
			$FORM{'self'} = 'azc';
			$sa = 'uacf';
			}



		if ($sa eq 'uacf') {

			my $parent = $FORM{'server'} eq 'Apache' ? 'aih' : 'zih';

			print "<p><b>$linkmaster{'AP'} &gt; $linkmaster{$parent} &gt; $linkmaster{$FORM{'self'}}</b></p>\n";

print <<"EOM";

<p>This script will attempt to configure this $FORM{'server'} web server so that HTTP errors will be redirected here.</p>

<p>The server configuration process often has to be done manually. You should be prepared to complete the process manually if this automated attempt fails.</p>

<ol>

EOM

			my $b_fail = 0;

			Process: {

				print '<li>';
				print "<p>Attempting to determine DOCUMENT_ROOT folder...</p>\n";

				my $doc_root = '';
				my $h_doc_root = '';

				Trial: {

					$doc_root = &query_env('DOCUMENT_ROOT');

					#netfirms correction:
					if (($doc_root =~ m!^/mnt/web_\w/\w\d+/\w\d+/\w\d+\w\d+$!) and (-d "$doc_root/www")) {
						print "<p><b>Status:</b> appears that this site runs at netfirms.com; applying netfirms DOC_ROOT correction.</p>\n";
						$doc_root .= "/www";
						}
					#virtualave corr:
					if (($doc_root eq '/home') and (-d "/home/public_html")) {
						print "<p><b>Status:</b> applying DOC_ROOT correction of /home =&gt; /home/public_html.</p>\n";
						$doc_root = "/home/public_html";
						}
					#portland.co.uk
					if ((&query_env('SERVER_ADMIN') eq 'support@portland.co.uk') and (&query_env('SCRIPT_FILENAME') =~ m!^/host/(.*)/(.*?).portland.co.uk/!)) {
						print "<p><b>Status:</b> applying DOC_ROOT correction of for portland.co.uk.</p>\n";
						$doc_root = "/host/$1/$2.portland.co.uk";
						}



					unless ($doc_root) {

						if (($system{'base_folder'}) and (-d $system{'base_folder'})) {
							print "<p><b>Warning:</b> DOCUMENT_ROOT environment variable is blank. All properly-configured $FORM{'server'} servers should have a DOCUMENT_ROOT variable which points to the folder containing the web site. We will continue using the 'Base Folder' system setting instead.</p>\n";
							$doc_root = $system{'base_folder'};
							}
						else {
							print "<p><b>Error:</b> DOCUMENT_ROOT environment variable is blank.</p>\n";

							print "<p><b>Warning:</b> DOCUMENT_ROOT environment variable is blank. All properly-configured $FORM{'server'} servers should have a DOCUMENT_ROOT variable which points to the folder containing the web site. If you know the full file system path to your web root folder, enter it under the Guardian System Settings and then try running this process again..</p>\n";

							$b_fail = 1;
							last Trial;
							}
						}

					$h_doc_root = &he($doc_root);

					unless (-d $doc_root) {
						print "<p><b>Error:</b> folder '$h_doc_root' does not exist or is not a directory.</p>\n";
						$b_fail = 1;
						last Trial;
						}

					print "<p><b>Status:</b> root folder is configured as '$h_doc_root'.</p>\n";

					}
				print '</li>';

				last Process if ($b_fail);


				print '<li>';
				print "<p>Checking for .htaccess file...</p>\n";

				my $htfile = $doc_root . '/.htaccess';
				my $h_htfile = &he( $htfile );

				my $htext = '';
				my $h_htext = '';
				my $new_htext = '';

				Trial: {

					if (not (-e $htfile)) {
						print "<p><b>Status:</b> there is not currently an access control file in the root.</p>\n";
						last Trial;
						}

					print "<p><b>Status:</b> there is already an access control file at $h_htfile.</p>\n";

					($err, $htext) = &ReadFile( $htfile );
					if ($err) {
						print "<p><b>Error:</b> $err.</p>\n";
						$err = '';
						$b_fail = 1;
						last Trial;
						}

					$new_htext = $htext;
					$h_htext = &he($htext);

print <<"EOM";

<p>Here are the contents of your current .htaccess file:</p>

<table border="1" cellpadding="8" cellspacing="0" width="90%">
<tr>
	<td align="left" nowrap="nowrap"><pre>$h_htext</pre></td>
</tr>
</table>

EOM

					print "<p>Checking for pre-existing ErrorDocument directives...</p>\n";

					if ($htext =~ m!ErrorDocument!is) {
						print "<p><b>Status:</b> .htaccess file already contains ErrorDocument directives.</p>\n";

						if ($FORM{'confirm'}) {
							print qq!<p><input type="checkbox" name="confirm" value="1" checked="checked" id="confirm_1" /><label for="confirm_1"> Yes, replace the existing directives.</label></p>\n!;
							print "<p>Attempting to replace existing ErrorDocument directives, per your request.</p>\n";


							my $x = '';
							foreach (split(m!\n!s, $new_htext)) {
								next if (m!ErrorDocument!i);
								next if (m!^\#guardian\# !i);
								$x .= "$_\n";
								}
							$new_htext = $x;
							}
						else {

print <<"EOM";

$const{'AdminForm'}
<input type="hidden" name="sa" value="$FORM{'self'}" />

<p>Please review the existing ErrorDocument directives listed above. Would you like to replace them with the Guardian directives? If so, check the checkbox below and then submit the form.</p>

<p><input type="checkbox" name="confirm" value="1" id="confirm_1" /><label for="confirm_1"> Yes, replace the existing directives.</label></p>

<p><input type="submit" class="submit" value="Replace ErrorDocument Directives" /></p>

</form>

EOM

							$b_fail = 1;
							}
						}
					else {
						print "<p>No pre-existing ErrorDocument directives found.</p>\n";
						}

					}

				print '</li>';
				last Process if ($b_fail);



				print '<li>';
				print "<p>Adding ErrorDocument directives and attempting to save the file...</p>\n";

				Trial: {

					my $handler_url = $const{'admin_url'};
					$handler_url =~ s!\?.*!!;
					$handler_url =~ s!ag-admin!ag!;

					my $date = &FormatDateTime( time(), 12 );

$new_htext .= "\n";
$new_htext .= "#guardian# Added by Guardian auto-config\n";
$new_htext .= "#guardian# These lines should invoke a custom error handler\n";
$new_htext .= "#guardian# added $date\n";

					local $_;
					foreach (401, 403, 404, 500) {

						if ($FORM{'server'} eq 'Apache') {
							$new_htext .= "ErrorDocument $_ $handler_url\n";
							}
						else {
							$new_htext .= "ErrorDocument $_ $handler_url?$_\n";
							}
						}

$new_htext .= "#guardian# / end Guardian stuff\n";
$new_htext .= "\n";

					my $h_new_htext = &he( $new_htext );

print <<"EOM";

<p>Your updated .htaccess file should contain the following text:</p>

<p><textarea rows="10" cols="80" name="text" wrap="off">$h_new_htext</textarea></p>

<p>We will attempt to automatically update the file now. If the update operation fails, then you will have to manually update the file by entering the text quoted in the textarea above.</p>


EOM

					if (-e $htfile) {
						# make a backup copy...

						my $name = $date;
						$name =~ s!\W!_!g;

						$name = $doc_root . "/.htaccess.bak.$name";

						my $h_name = &he( $name );


						print "<p>Because there is already an .htaccess file present, we will make a backup to '$h_name' before updating the main copy.</p>\n";


						$err = &WriteFile( $name, $htext );
						if ($err) {
							print "<p><b>Error:</b> $err.</p>\n";
							$err = '';
							print "<p>Unable to save backup copy (probably because we do not have write access to the root folder). It is therefore not safe to try to update the master file. Please manually update the file to contain the text quoted above.</p>\n";
							$b_fail = 1;
							last Trial;
							}

						print "<p><b>Success:</b> saved backup copy of file.</p>\n";

						}


					$err = &WriteFile( $htfile, $new_htext );
					if ($err) {
						print "<p><b>Error:</b> $err.</p>\n";
						$err = '';
						$b_fail = 1;
						last Trial;
						}
					print "<p><b>Success:</b> updated file '$h_htfile'.</p>\n";

					}

				print '</li>';
				last Process if ($b_fail);


				my $test = "/nothing/nothing/" . int(rand(1000000)) . "/";

				print '<li>';
				print qq!<p>You should now test the script by requesting a document which does not exist, like <a href="$test" target="_blank">$test</a>. You should see a Guardian custom error message. If you do not, please refer to the manual configuration instructions and the trouble-shooting steps there.</p>\n!;
				print '</li>';

				}

			print '</ol>';

			print "<p>Return to <b>$linkmaster{$parent}</b>.</p>\n";

			last Err;
			}

		#alias
		if ($sa eq 'aih') {
			$sa = 'server_config_help';
			$FORM{'template'} = '1001.html';
			}
		if ($sa eq 'iih') {
			$sa = 'server_config_help';
			$FORM{'template'} = '1000.html';
			}
		if ($sa eq 'zih') {
			$sa = 'server_config_help';
			$FORM{'template'} = '1008.html';
			}


		if ($sa eq 'server_config_help') {

			my $template = $FORM{'template'} || '';

			unless (-e "$system{'language'}/$template") {
				my $hfile = &he("$system{'language'}/$template");
				$err = "file $hfile does not exist";
				next Err;
				}

			my %replace = %const;

			$replace{ 'error_handler' } = $const{'admin_url'};
			$replace{ 'error_handler' } =~ s!ag-admin!ag!i;
			$replace{ 'error_handler' } =~ s!\?.*$!!;

			$replace{ 'invalid_test_url1' } = "/nothing/nothing/" . int(rand(1000000)) . "/";
			$replace{ 'invalid_test_url2' } = "/nothing/nothing/" . int(rand(1000000)) . "/";


			if ($template eq '1001.html') {
				print "<p><b>$linkmaster{'AP'} &gt; $linkmaster{'aih'}</b></p>\n";
				}
			elsif ($template eq '1000.html') {
				print "<p><b>$linkmaster{'AP'} &gt; $linkmaster{'iih'}</b></p>\n";
				}
			elsif ($template eq '1008.html') {
				print "<p><b>$linkmaster{'AP'} &gt; $linkmaster{'zih'}</b></p>\n";
				}
			else {
				print "<p><b>$linkmaster{'AP'}</b></p>\n";
				}

			print &ParseTemplate( $template, $system{'language'}, \%replace );

			last Err;
			}


		if ($sa eq 'set_fhelp') {

			print "<p><b>$linkmaster{'AP'} &gt; Display Setup Help</b></p>\n";

			$system{'b_is_first_time'} = $FORM{'display'} ? 1 : 0;

			$err = &validate_system_settings(1);
			next Err if ($err);
			$err = &save_system_settings();
			next Err if ($err);

			if ($FORM{'display'}) {
				print "<p><b>Success:</b> the first-time user help will now be displayed by default.</p>\n";
				print "<p>Go to <b><a href=\"$const{'admin_url'}\">First-Time User Help</a></b> now.</p>\n";
				}
			else {
				print "<p><b>Success:</b> the normal admin page will be displayed by default.</p>\n";
				print "<p>You can return to the first-time user help by choosing the link at the bottom of the main admin page.</p>\n";
				print "<p>Go to normal <b>$linkmaster{'AP'}</b>.</p>\n";
				}

			last Err;
			}


		if ($sa eq 'testmsg') {
			print "<p><b>$linkmaster{'AP'} &gt; $linkmaster{'TEST'} &gt; $str[5]</b></p>\n";

			&GetErrorInfo();

			my $trace = '';
			($err, $trace) = &SendMailEx(
				'to' => $system{'email_address'},
				'from' => $system{'email_address'},
				'raw' => &BuildMessage(''),
				'host' => $system{'smtp_server'},
				'pipeto' => $system{'sendmail_program'},
				);
			next Err if ($err);

			print "<p><b>Success:</b> sent test message.</p>\n";
			print "<pre>" . &he($trace) . "</pre>";

			last Err;
			}

		if ($sa eq 'env') {

			my $list = '';
			foreach (sort keys %ENV) {
				my ($name, $value) = &he($_, $ENV{$_});
				$list .= qq!<tr><td align="right"><b>$name:</b></td><td>$value<br /></td></tr>\n!;
				}

print <<"EOM";

<p><b>$linkmaster{'AP'} &gt; $linkmaster{'TEST'} &gt; <a href="$const{'admin_url'}sa=env">Environment Variables</a></b></p>

<table border="1" cellpadding="4" cellspacing="1">
<tr>
	<th>Name</th>
	<th>Value</th>
</tr>
$list
</table>

<p><br /></p>

EOM

			last Err;
			}


		if ($sa eq 'TEST') {

print <<"EOM";

<p><b>$linkmaster{'AP'} &gt; $linkmaster{'TEST'} &gt; $str[27]</b></p>

<hr size="1" />

<p><b>$linkmaster{'RsysL'}</b></p>

<p><br /></p>

<hr size="1" />

$const{'AdminForm'}
<input type="hidden" name="sa" value="sim" />

<p><b>Test Error Response</b></p>

<table border="0" cellpadding="4" cellspacing="1">
<tr>
	<th>Name</th>
	<th>Value / Example</th>
</tr>
<tr class="s">
	<td align="right"><b>Error URL:</b></td>
	<td><input size="42" name="sim::REDIRECT_URL" value="/nothing/doc.txt" /></td>
</tr>
<tr class="s">
	<td align="right"><b>Error Code:</b></td>
	<td><select name="sim::REDIRECT_STATUS">
		<option>401</option>
		<option>403</option>
		<option selected="selected">404</option>
		<option>500</option>
	</select></td>
</tr>
<tr class="s">
	<td align="right"><b>Referring URL:</b></td>
	<td><input size="42" name="sim::HTTP_REFERER" value="http://www.microsoft.com/" /></td>
</tr>
<tr class="s">
	<td align="right"><b>User Agent:</b></td>
	<td><input size="42" name="sim::HTTP_USER_AGENT" value="Mozilla/4.0 (compatible; Foobar)" /></td>
</tr>
<tr>
	<td><br /></td>
	<td><input type="submit" class="submit" value="$str[26]" /></td>
</tr>
</table>
</form>

<p><br /></p>

<hr size="1" />

<p><b>$str[4]</b></p>

EOM

if ($system{'email_address'}) {


print <<"EOM";

$const{'AdminForm'}
<input type="hidden" name="sa" value="testmsg" />
<p><input type="submit" class="submit" value="$str[5]" /></p>
</form>

EOM
	}
else {
	&pppstr( 51, $linkmaster{'MSS'} );
	}



print <<"EOM";

<hr size="1" />

<p><b>System Information</b></p>

EOM
			&pppstr(50, $], $^X, $^O, &query_env('SERVER_SOFTWARE'));

			print qq!<p>[ <a href="$const{'admin_url'}sa=env">Environment Variables</a> ]</p>\n!;


			my $time = time();
			my $tlocal = &FormatDateTime( $time, 12, 0 );
			my $tgmt = &FormatDateTime( $time, 12, 1 );

			my $cmp = $tgmt . '.' . $time;
			$cmp =~ s!\D+!.!g;

print <<"EOM";

<hr size="1" />

<p><b>Date and Time</b></p>

<table border="1" cellpadding="4" cellspacing="1">
<tr>
	<td align="right"><b>Server local time:</b></td>
	<td>$tlocal</td>
</tr>
<tr>
	<td align="right">Server GMT time:</td>
	<td>$tgmt</td>
</tr>
<tr>
	<td align="right">Browser local time:</td>
	<td>

<script type="text/javascript">
<!--
function Pad2(val) {
	var len = ("" + val).length;
	if (len == 0) {
		return "00";
		}
	else if (len == 1) {
		return "0" + val;
		}
	else {
		return val;
		}
	}

var MyDate = new Date();
document.write( MyDate.getYear() + '-' + Pad2(1 + MyDate.getMonth()) + '-' + Pad2(MyDate.getDate()) + ' ' + Pad2(MyDate.getHours()) + ':' + Pad2(MyDate.getMinutes()) + ':' + Pad2(MyDate.getSeconds()) );

var ServerT = $time;
var BrowserT = MyDate.getTime() / 1000;
var offset = (ServerT - BrowserT);
if (offset < 0) {
	offset *= -1;
	}
offset = Math.round(offset);
var omin = Math.round(offset/60);
var osec = offset % 60;

document.write( " - offset of " + omin + " min " + osec + " sec");

//-->
</script>
<noscript>
	requires javascript
</noscript>

	</td>
</tr>

</table>

<p>This script uses <b>server local time</b>. Server GMT and local browser time are provided for reference. Differences of a few seconds between the times is expected and is probably due to network delays.</p>

<p>You may also compare to <a href="$const{'admin_url'}sa=TCMP">xav.com/time.cgi</a>.</p>

EOM

			last Err;
			}


		if (($sa) and ($sa ne 'AP')) {
			my $hsa = &he($sa);
			$err = "subaction '$hsa' not defined";
			next Err;
			}

		print "<p><b>$linkmaster{'AP'}</b></p>\n";
		print "<p>$str[46]</p>\n";

		if ($system{'b_is_first_time'}) {

			my $webss_file = '1001.html';
			my $webss = &query_env('SERVER_SOFTWARE', 'Unknown');
			my $webss_short = $webss;

			if ($webss =~ m!apache!i) {
				$webss_file = '1001.html';
				$webss_short = 'Apache';
				}
			elsif ($webss =~ m!iis!i) {
				$webss_file = '1000.html';
				$webss_short = 'Microsoft IIS';
				}
			elsif ($webss =~ m!zeus!i) {
				$webss_file = '1008.html';
				$webss_short = 'Zeus';
				}

			my $para = &pstr( 47, "$const{'help_file'}$webss_file" );

			my $test_url = '/nothing/nothing/' . int(rand(100000)) . '/';

			my %step_done = map { $_ => 1 } split(m!,!, $system{'ft_status'});

			my $b_save = 0;

			if ($FORM{'ft_done'}) {
				$step_done{ $FORM{'ft_done'} } = 1;
				$b_save = 1;
				}
			elsif ($FORM{'ft_clear'}) {
				delete $step_done{ $FORM{'ft_clear'} };
				$b_save = 1;
				}

			if ($b_save) {
				$system{'ft_status'} = join( ',', keys %step_done );
				$err = &save_system_settings();
				next Err if ($err);
				}

			my @step_status = ();
			for (1..5) {

				if ($step_done{ $_ }) {

				$step_status[ $_ ] = <<"EOM";

<table border="1" cellpadding="4" cellspacing="0" width="400">
<tr>
	<td class="completed" align="center" width="30"><b>x</b></td>
	<td class="completed">Step completed (<a href="$const{'admin_url'}ft_clear=$_" class="acompleted">clear</a>)</td>
</tr>
</table>

EOM
					}
				else {

				$step_status[ $_ ] = <<"EOM";

<table border="1" cellpadding="4" cellspacing="0" width="400">
<tr>
	<td class="waiting" align="center" width="30"><b class="waitingtext">x</b></td>
	<td class="waiting">Waiting for completion (<a href="$const{'admin_url'}ft_done=$_">done</a>)</td>
</tr>
</table>

EOM
					}


				}

			my $platwarn = '';
			if (($ENV{'HTTP_HOST'}) and ($ENV{'HTTP_HOST'} =~ m!\.netfirms\.com$!i)) {
				$platwarn = qq!<hr size="1" width="80%" align="center" /><p><b>Warning:</b> it appears that you are hosted at netfirms.com. This software does not function properly at netfirms.com (see <a href="$const{'help_file'}1703.html" target="_blank">this help file</a>; updated 2002-08-04).</p><p>Web hosts change their policies frequently. You may want to try to configure the error-handling anyway, in case it works now.</p><hr size="1" width="80%" align="center" />\n!;
				}



print <<"EOM";

<table border="1" cellpadding="8" cellspacing="0" width="90%">
<tr>
	<td align="left">

		<p><b>First-Time User Instructions</b></p>

		$platwarn

		<p>Follow these simple instructions to configure this script.</p>

		<ol>

			<li>

				<p><b>Configure Server for Error Redirection</b></p>

				<p>First you need to configure your web server so that it redirects all errors to this script for handling.</p>

				<p>Your web server software has been detected as <b>$webss</b>. Click here for a <a href="$const{'admin_url'}sa=server_config_help&amp;template=$webss_file">customized help file</a> which describes how to set up error redirection for $webss_short server software.</p>

				$step_status[1]

				<p><br /></p>

			</li>
			<li>

				<p><b>Test Error Redirection</b></p>

				<p>Once the server is configured, visit an invalid URL like <a href="$test_url" target="_blank">$test_url</a> to make sure that Guardian is handling your errors.</p>

				<p>If Guardian is not handling the errors, review the final portion of <a href="$const{'admin_url'}sa=server_config_help&amp;template=$webss_file" target="_blank">this help file</a> for trouble-shooting help.</p>

				$step_status[2]

				<p><br /></p>

			</li>
			<li>

				<p><b>Customize Error Messages</b></p>

				<p>Use the Guardian $linkmaster{'LT'} interface to customize the content and style of all error messages. You can make the error messages have the same layout as your web site.</p>

				$step_status[3]

				<p><br /></p>

			</li>
			<li>

				<p><b>Set Error Notification Preferences</b></p>

				<p>By default, all errors will be logged to a file, and none will result in sending email to you.</p>

				<p>To receive email notification of each error, first visit the $linkmaster{'MSS'} interface to enter your email address and mail sending options.</p>

				<p>Then, go to the $linkmaster{'MFR'} interface to customize the global "ignore" rules. Note that configuring Filter Rules is a big task. If you simply want to enable all email notification, just comment out the "any: *; ignore: 1" rule.</p>

				$step_status[4]

				<p><br /></p>

			</li>
			<li>

				<p><b>Choose License Mode</b></p>

				<p>You can use Guardian in Freeware or Registered mode. Visit the $linkmaster{'UL'} interface to review the differences between the modes and to select one.</p>

				<p>By default, Guardian is installed in Trial mode, which has features similar to Registered mode. You may stay in Trial mode for a reasonable time while testing the product, but after testing you must choose either Freeware or Registered mode.</p>

				$step_status[5]

				<p><br /></p>

			</li>
			<li>

				<p><b>Setup Complete</b></p>

				<p>Click here to <a href="$const{'admin_url'}sa=set_fhelp&amp;display=0">stop displaying first-time user help</a>. The normal admin interface will be shown instead. You will still be able to return to first-time user help at any time.</p>

				<p><br /></p>

			</li>

		</ol>

		<p>Always <a href="$const{'admin_url'}sa=SO">sign out</a> when you are finished using this system.</p>

	</td>
</tr>
</table>

<p><br /></p>


EOM


		}
	else {

		my $warnings = '';

		my $logsize = -s 'errors.log';
		if (($logsize) and ($logsize >= $system{'MaxLogBytes'})) {

$warnings .= <<"EOM";

<p><b>Warning:</b> the log file 'errors.log' has grown to $logsize bytes, which exceeds the size limit for log files.</p>

<p>Please visit the $linkmaster{'RL'} page to review the error log and delete old entries. Or, you may visit $linkmaster{'MSS'} and increase the "Maximum Log Size" setting.</p>

EOM
			}

		$logsize = -s 'syslog';
		if (($logsize) and ($logsize >= $system{'MaxLogBytes'})) {
$warnings .= <<"EOM";

<p><b>Warning:</b> the log file 'syslog' has grown to $logsize bytes, which exceeds the size limit for log files.</p>

<p>Please visit the $linkmaster{'RsysL'} page to review the system error log and delete old entries. Or, you may visit $linkmaster{'MSS'} and increase the "Maximum Log Size" setting.</p>

EOM
			}




		if (-s 'syslog') {
$warnings .= <<"EOM";

<p><b>Warning:</b> this script has recently experienced some internal errors. Please visit the $linkmaster{'RsysL'} page and take steps to resolve the errors. This warning will remain until the errors have been cleared.</p>

EOM

			}

		if ($warnings) {
			print qq!<table border="1" cellpadding="4" cellspacing="1" bgcolor="#cc0000"><tr><td align="left" bgcolor="#ffffff">$warnings</td></tr></table>!;
			}

print <<"EOM";

<dl>

	<dt><b>$linkmaster{'MSS'}</b></dt>
	<dd><p>$str[45]</p></dd>

	<dt><b>$linkmaster{'MFR'}</b></dt>
	<dd><p>$str[44]</p></dd>

	<dt><b>$linkmaster{'LT'}</b></dt>
	<dd><p>$str[43]</p></dd>

	<dt><b>$linkmaster{'RL'}</b></dt>
	<dd><p>$str[42]</p></dd>

	<dt><b>$linkmaster{'TEST'}</b></dt>
	<dd><p>$str[41]</p></dd>

	<dt><b>$linkmaster{'UL'}</b></dt>
	<dd><p>Purchase or enter registration key. Select Freeware, Trial, or Registered mode.</p></dd>

	<dt><b><a href="$const{'admin_url'}sa=SO">Sign Out</a></b></dt>
	<dd><p>$str[40]</p></dd>

</dl>

<p>Click to <a href="$const{'admin_url'}sa=set_fhelp&amp;display=1">display first-time user help</a> instead of the normal admin page.</p>

EOM
			}

		last Err;
		}
	continue {
		print "Content-Type: text/html\015\012\015\012" unless ($const{'has_http_header'});
		&ppstr( 1, $err );
		}


	if ($const{'needs_html_footer'}) {

print <<"EOM";

	<hr size="1" />

	</td>
</tr>
</table></center></body>
</html>

EOM
		}

	return $b_is_done;
	}




sub save_system_settings {
	my $err = '';
	Err: {
		if ($const{'mode'} == 0) {
			$err = "unable to save settings in the online demo";
			next Err;
			}
		my ($name, $value, $text) = ('', '', '');
		while (($name, $value) = each %system) {
			$text .= &url_encode($name) . '=' . &url_encode($value) . "\n";
			}
		$err = &WriteFile('system.txt', $text);
		next Err if ($err);
		&setchmod( 'system.txt' );
		last Err;
		}
	return $err;
	}







sub regkey_verify {
	print "HTTP/1.0 200 OK\015\012" if ($const{'PRINT_HTTP_STATUS_HEADER'});
	print "Content-Type: text/html\n\n";
	my $err = '';
	Err: {
		my $god = 'xav.com';
		eval 'use Socket;';
		# only allow audits from known host
		my $ip = &query_env('REMOTE_ADDR');
		unless ($ip =~ m!^(\d+)\.(\d+)\.(\d+)\.(\d+)$!) {
			$err = "unable to extract visitor IP address";
			next Err;
			}
		my $hexip = pack('C4', $1, $2, $3, $4);
		my $name = gethostbyaddr( $hexip, &AF_INET() );
		if ($name ne $god) {
			$err = "permission denied; audits must be spawned from '$god'. Reverse DNS failed";
			next Err;
			}
		my $addr = gethostbyname($god);
		if ($hexip ne $addr) {
			$err = "permission denied; audits must be spawned from '$god'. Forward DNS failed";
			next Err;
			}
		my $auth_verify = '';
		my $x = 0;
		for $x (1..4) {
			$auth_verify .= crypt($FORM{"FDT_$x"}, "xv" );
			}
		if ($auth_verify ne 'xvQVBe9hiuSKMxvgMWOQj32iyAxvB2dl2Jl11JgxvKNwbBX1hQU2') {
			$err = "crypt audit failed; received '$auth_verify'";
			next Err;
			}
		print $const{'VERSION'} . "\n\n\n" . (stat('.webauth_tokens'))[9] . "\n\n\n" . $const{'mode'} . "\n\n\n" . &url_decode($system{'RegKey'});
		last Err;
		}
	continue {
		&ppstr(1, $err );
		}
	}



=item WebAuthEx

Usage:
	my $auth_obj = &WebAuthEx();

Dependencies:

	Called by: admin_main

	Global: none

	Dependency: _WAX_SetPassword - 1

	Required library: ../2.0.0.0002/files/guardian/ag-shared.txt

=cut

sub WebAuthEx {
	my (%options) = @_;
	my $self = {};
	my $err = '';
	Err: {
		$self->{'data_folder'} = '.';
		$self->{'make_starter_accounts'} = 0;
		$self->{'seed'} = 'sX';
		my ($name, $value) = ();
		while (($name, $value) = each %options) {
			$self->{$name} = $value;
			}
		$self->{'data_folder'} =~ s!\\!/!g;
		$self->{'data_folder'} .= '/';
		$self->{'data_folder'} =~ s!//!/!g;
		$self->{'AuthFile'} = $self->{'data_folder'} . '.webauth_passwd';
		$self->{'TokenFile'} = $self->{'data_folder'} . '.webauth_tokens';


		$self->{'default_user'} = 'webmaster';
		$self->{'default_pass'} = '658uwantit';

		bless($self);
		if ($self->{'make_starter_accounts'}) {
			unless (-e $self->{'AuthFile'}) {
				$err = $self->_WAX_SetPassword( $self->{'default_user'}, $self->{'default_pass'} );
				next Err if ($err);
				}
			}
		last Err;
		}
	return ($err, $self);
	}



sub _WAX_Delete {
	my ($self, $username) = @_;
	my $err = '';
	Err: {
		local $_;
		my $file = $self->{'AuthFile'};
		my $text = '';
		my $new = '';
		my $b_changed = 0;

		($err, $text) = &ReadFile($file);
		next Err if ($err);
		foreach (split(m!\n!s, $text)) {
			next unless (m!^(.*?)\:(.*?)\r?$!s);
			my ($user, $crypt) = ($1, $2);
			if ($user eq $username) {
				$b_changed++;
				next;
				}
			$new .= "$user:$crypt\n";
			}
		if ($b_changed) {
			$err = &WriteFile($file, $new);
			next Err if ($err);
			&setchmod( $file );
			}
		else {
			$err = "unable to find user '" . &he($username) . "'";
			next Err;
			}
		$err = $self->_WAX_flush_tokens( $username );
		next Err if ($err);
		}
	return $err;
	}


=item _WAX_UpdatePassword

Usage:
	$err = $auth->_WAX_UpdatePassword( $username, $current_passwd, $new_passwd, $confirm_passwd );
	if ($err) {
		print "<p><b>Error:</b> $err.</p>\n";
		}
	else {
		print "<p><b>Success:</b> updated password for user '$username'.</p>\n";
		}

Dependencies:

	Called by: _WAX_Challenge
	Called by: admin_main

	Global: none

	Dependency: _WAX_SetPassword - 1
	Dependency: _WAX_ValidatePassword - 1

	Required library: ../2.0.0.0002/files/guardian/ag-shared.txt

=cut

sub _WAX_UpdatePassword {
	my ($self, $username, $current_passwd, $new_passwd, $confirm_passwd) = @_;
	my $err = '';
	Err: {
		unless ($new_passwd eq $confirm_passwd) {
			$err = "new password does not match confirmed new password";
			next Err;
			}
		my $is_valid = 0;
		($err, $is_valid) = $self->_WAX_ValidatePassword( $username, $current_passwd );
		next Err if ($err);
		unless ($is_valid) {
			$err = "current username/password not valid";
			next Err;
			}
		$err = $self->_WAX_SetPassword( $username, $new_passwd );
		next Err if ($err);
		}
	return $err;
	}


=item _WAX_ValidatePassword($$)

Usage:
	($err, $is_valid) = $auth->_WAX_ValidatePassword( $username, $password );
	next Err if ($err);
	if ($is_valid) {
		print "<p>Password is valid for '$username'.</p>\n";

		$err = $auth->_WAX_SetPassword( $username, $newpass );
		next Err if ($err);

		print "<p>Updated password.</p>\n";

		}
	else {
		print "<p><b>Error:</b> username or password not valid.</p>\n";
		}

=cut




sub _WAX_SetPassword {
	my ($self, $username, $password) = @_;
	my $err = '';
	Err: {
		my $file = $self->{'AuthFile'};
		my $crypt = crypt($password, $self->{'seed'});
		if (-e $file) {
			$err = $self->_WAX_Delete( $username );
			next Err if ($err);
			}
		unless (open(FILE, ">>$file")) {
			$err = "unable to open file '$file' for appending - $!";
			next Err;
			}
		unless (binmode(FILE)) {
			$err = "unable to set binmode on file '$file' - $!";
			next Err;
			}
		print FILE "$username:$crypt\n";
		close(FILE);
		&setchmod( $file );
		}
	return $err;
	}

sub _WAX_ValidatePassword {
	my ($self, $username, $password) = @_;

	my $is_valid = 0;
	my $err = '';
	Err: {
		local $_;

		my $file = $self->{'AuthFile'};

		my $text = '';
		($err, $text) = &ReadFile($file);
		next Err if ($err);

		foreach (split(m!\n!s, $text)) {
			next unless (m!^(.*?)\:(.*?)\r?$!);
			my ($user, $crypt) = ($1, $2);
			if ($user eq $username) {
				if ($crypt eq crypt($password, $self->{'seed'})) {
					$is_valid = 1;
					}
				else {
					sleep(4);
					}
				last;
				}
			}
		}
	return ($err, $is_valid);
	}


=item _WAX_Challenge

my ($is_auth, $private_token, $auth_username, $is_cookies_aware, $is_initial_login, $html_out) = $obj->_WAX_Challenge( \%FORM, $b_logout );

if username & password
	validate

else if token exists
	validate token

if not valid

	if b_allow_anon
		return is_auth = 0
	else
		interactive prompt for user/pass
		return is_auth = 0
	}


This subroutine is allowed to write Set-Cookie headers directly to STDOUT. All of its HTML output otherwise goes to $html_out, which can be inserted inside a template.

Dependencies:

	Called by: admin_main

	Global: %FORM - 20

	Dependency: _WAX_UpdatePassword - 1
	Dependency: _WAX_ValidatePassword - 1
	Dependency: _WAX_read_tokens - 2
	Dependency: _WAX_write_tokens - 2
	Dependency: he - 4

	Required library: ../2.0.0.0002/files/guardian/ag-shared.txt

=cut

sub _WAX_Challenge {
	my ($self, $p_FORM, $b_logout, $b_allow_anon) = @_;

	my ($v1, $v2) = ('', '');

	if ($const{'mode'} == 0) {
		$v1 = 'webmaster';
		$v2 = '658uwantit';
		}

	my $html_out = '';

	my $trace = '';

	my $status_msg = '';

	my ($private_token, $public_token, $form_username, $form_password, $is_initial_login) = ('', '', '', '', 0);

	my $test_cookie = '0';
	my $is_cookies_aware = 0;
	if ($ENV{'HTTP_COOKIE'} and ($ENV{'HTTP_COOKIE'} =~ m!web_auth_cp=([^\;]+)!)) {
		$is_cookies_aware = 1;
		my $auth_cookie = $1;
		if ($auth_cookie ne $test_cookie) {
			$private_token = $auth_cookie;
			}
		}
	if (($p_FORM) and ('HASH' eq ref($p_FORM))) {
		if ($$p_FORM{'web_auth_cp'}) {
			$private_token = $$p_FORM{'web_auth_cp'};
			}
		if ($$p_FORM{'web_auth_user'}) {
			$form_username = $$p_FORM{'web_auth_user'};
			}
		if ($$p_FORM{'web_auth_pass'}) {
			$form_password = $$p_FORM{'web_auth_pass'};
			}
		}

	$trace .= "<p>Your auth_token is: '$private_token'</p>\n";



	my ($is_auth, $auth_username) = (0, '');

	my $script_name = $0;
	if ($ENV{'SCRIPT_NAME'}) {
		$script_name = $ENV{'SCRIPT_NAME'};
		}
	elsif ($0 =~ m!^.*(\\|/)(.*?)$!) {
		$script_name = $2;
		}


	my $session_lifetime = 3600; # 1 hour
	my $grace_period = 600; # 10 min

	my %auth_tokens = ();


	my $clear_cookie = 0;

	my $err = '';
	Err: {

		next Err if ($b_logout);

		if (($form_username) and ($form_password)) {

			my $is_valid = 0;
			($err, $is_valid) = $self->_WAX_ValidatePassword( $form_username, $form_password );
			next Err if ($err);

			unless ($is_valid) {
				$err = "invalid username or password";
				next Err;
				}

# are we running on defaults?

			if (($const{'mode'}) and ($form_username eq $self->{'default_user'}) and ($form_password eq $self->{'default_pass'})) {

				if ($$p_FORM{'web_auth_p1'}) {

					$err = $self->_WAX_UpdatePassword( $form_username, $form_password, $$p_FORM{'web_auth_p1'}, $$p_FORM{'web_auth_p2'} );
					if ($err) {
						$status_msg = "<p><b>Error:</b> $err.</p>\n";
						}
					else {
						$status_msg = "<p><b>Success:</b> new custom password assigned. You may now log in.</p>\n";
						$v1 = $form_username;
						next Err;
						}
					}


$html_out = <<"EOM";

<form method="post" action="$script_name" name="F1">

EOM

		unless ($b_logout) {
			my ($name, $value) = ();
			while (($name, $value) = each %$p_FORM) {
				next if ($name =~ m!^web_auth_!i);
				$html_out .= "<input type=\"hidden\" name=\"" . &he($name) . "\" value=\"" . &he($value) . "\" />\n";
				}
			}

$html_out .= <<"EOM";

		<p>Login successful using default username and password. Now please customize your password:</p>

		<table border="0">


			<tr>
				<td align="right" width="120"><b>Username:</b></td>
				<td><tt><input name="web_auth_user" value="$$p_FORM{'web_auth_user'}" /></tt></td>
			</tr>
			<tr>
				<td align="right"><b>Password:</b></td>
				<td><tt><input type=password name="web_auth_pass" value="$$p_FORM{'web_auth_pass'}" /></tt></td>
			</tr>
			<tr>
				<td align="right"><b>New Password:</b></td>
				<td><tt><input type=password name="web_auth_p1" /></tt></td>
			</tr>
			<tr>
				<td align="right"><b>Confirm:</b></td>
				<td><tt><input type=password name="web_auth_p2" /></tt></td>
			</tr>
			<tr>
				<td><br /></td>
				<td><input type="submit" class="submit" value="Update Password" /></td>
			</tr>
		</table>
		</form>

		$status_msg

		<script type="text/javascript">
		<!--
		if (document && document.F1 && document.F1.web_auth_p1) {
			document.F1.web_auth_p1.focus();
			}
		// -->
		</script>



EOM

				last Err;
				}









			# the user provided a valid password; give that man a token!

			$is_initial_login = 1;

			$err = $self->_WAX_read_tokens( \%auth_tokens );
			next Err if ($err);

			$private_token = '';
			foreach (1..16) {
				$private_token .= chr(ord('a') + int(rand(26)));
				}
			$public_token = crypt($private_token, $self->{'seed'});
			my $expires = time() + $session_lifetime;
			$auth_tokens{$public_token} = "$expires,$form_username";

			$err = $self->_WAX_write_tokens( \%auth_tokens );
			next Err if ($err);

			$auth_username = $form_username;
			$is_auth = 1;
			last Err;
			}



		if ($private_token) {

			$err = $self->_WAX_read_tokens( \%auth_tokens );
			next Err if ($err);

			$public_token = crypt($private_token, $self->{'seed'});

			$trace .= "<p>YOur public token is '$public_token'</p>";

			unless ($auth_tokens{$public_token}) {
				sleep(4);
				$err = "authentication token not found";
				next Err;
				}

			$auth_tokens{$public_token} =~ m!^(\d+),(.*)$!;
			my ($expires, $username) = ($1, $2);

			if ($expires < time()) {
				my $ago = time() - $expires;
				$clear_cookie = 1 if ($is_cookies_aware);
				$err = "session expired";
				next Err;

				}
			elsif (($expires - $grace_period) < time) {

				# this token is about to expire; set a fresh one:

				$private_token = '';
				foreach (1..8) {
					$private_token .= chr(ord('a') + int(rand(26)));
					}
				$public_token = crypt($private_token, $self->{'seed'});

				$expires = time() + $session_lifetime;
				$auth_tokens{$public_token} = "$expires,$username";

				$err = $self->_WAX_write_tokens( \%auth_tokens );
				next Err if ($err);

				}
			else {
				# is current token
				}

			$is_auth = 1;
			$auth_username = $username;

			last Err;

			}
		}

	continue {

		if ($b_allow_anon) {
			return (0,'','',0,0);
			}

		if ($status_msg) {
			# keep
			}
		elsif ($b_logout) {
			$status_msg = "<p><b>Success:</b> you have been logged out.</p>\n";
			}
		elsif ($err) {
			$status_msg = "<p><b>Error:</b> $err.</p>\n";
			}



		# AUTH_FAIL

		print "Set-Cookie: web_auth_cp=; path=/\015\012" if ($clear_cookie);
		print "Set-Cookie: web_auth_cp=$test_cookie; path=/\015\012";


		my $template = '';
		my $text = '';


$html_out .= <<"EOM";

		<form method="post" action="$script_name" name="F1">

EOM

		unless ($b_logout) {
			my ($name, $value) = ();
			while (($name, $value) = each %$p_FORM) {
				next if ($name =~ m!^web_auth_!i);
				$html_out .= "<input type=\"hidden\" name=\"" . &he($name) . "\" value=\"" . &he($value) . "\" />\n";
				}
			}


		my $focus = 'web_auth_user';
		if (($v1) and (not $v2)) {
			$focus = 'web_auth_pass';
			}


$html_out .= <<"EOM";

		<p>Please enter your username and password:</p>
		<table border="0">
			<tr>
				<td align="right" width="120"><b>Username:</b></td>
				<td><tt><input name="web_auth_user" value="$v1" /></tt></td>
			</tr><tr align="right">
				<td><b>Password:</b></td>
				<td><tt><input type="password" name="web_auth_pass" value="$v2" /></tt></td>
			</tr><tr>
				<td><br /></td>
				<td><input type="submit" class="submit" value="Log In" /></td>
			</tr>
		</table>

		$status_msg

		</form>
		<script type="text/javascript">
		<!--
		if ((document) && (document.F1) && (document.F1.$focus)) {
			document.F1.$focus.focus();
			}
		// -->
		</script>
EOM



		}
	if ($is_auth) {
		print "Set-Cookie: web_auth_cp=$private_token; path=/\015\012";
		}
	return ($is_auth, $private_token, $auth_username, $is_cookies_aware, $is_initial_login, $html_out);
	}


=item _WAX_flush_tokens

($)

Usage:
	$err = $auth->flush_tokens();
	$err = $auth->flush_tokens( $username_pattern );

Dependencies:

	Called by: _WAX_Delete

	Global: none

	Dependency: _WAX_read_tokens - 1
	Dependency: _WAX_write_tokens - 2

	Required library: ../2.0.0.0002/files/guardian/ag-shared.txt

=cut

sub _WAX_flush_tokens {
	my ($self, $pattern) = @_;
	my $err = '';
	Err: {
		my %auth_tokens = ();

		unless ($pattern) {
			$err = $self->_WAX_write_tokens( \%auth_tokens );
			last Err;
			}

		$err = $self->_WAX_read_tokens( \%auth_tokens );
		next Err if ($err);

		my @public_tokens = keys %auth_tokens;
		foreach (@public_tokens) {
			next unless ($auth_tokens{$_} =~ m!^(\d+),(.*)$!);
			my ($expires, $username) = ($1, $2);
			if ($username =~ m!$pattern!i) {
				delete $auth_tokens{$_};
				}
			}

		$err = $self->_WAX_write_tokens( \%auth_tokens );
		next Err if ($err);

		}
	return $err;
	}


=item _WAX_read_tokens

($)

Reads the hash %Tokens out of file $auth_file.

Usage:
	my $err = $auth->_WAX_read_tokens( \%Tokens );
	if ($err) {
		print "<p><b>Error:</b> $err.</p>\n";
		}

Dependencies:

	Called by: _WAX_Challenge
	Called by: _WAX_flush_tokens

	Global: @str - 1

	Dependency: ReadFile - 1

	Required library: ../2.0.0.0002/files/guardian/ag-shared.txt

=cut

sub _WAX_read_tokens {
	my ($self, $p_Tokens) = @_;
	my $err = '';
	Err: {
		my $file = $self->{'TokenFile'};
		last Err unless (-e $file);

		my $text = '';
		($err, $text) = &ReadFile($file);
		next Err if ($err);

		my $buffer = '';
		my $time = time();

		my $x = 0;
		for ($x = 0; $x < length($text); $x += 128) {
			$buffer = substr($text, $x, 128);
			my ($token, $expires, $username) = unpack('A60LA64', $buffer);
			next if ($expires < $time);
			$$p_Tokens{$token} = "$expires,$username";
			}
		}
	return $err;
	}


=item _WAX_write_tokens

($$)

Saves the %Tokens hash to file $auth_file.

Usage:
	my $err = $auth->write_tokens( \%Tokens );
	if ($err) {
		print "<p><b>Error:</b> $err.</p>\n";
		}

Dependencies:

	Called by: _WAX_Challenge
	Called by: _WAX_flush_tokens

	Global: none

	Dependency: WriteFile - 1

	Required library: ../2.0.0.0002/files/guardian/ag-shared.txt

=cut

sub _WAX_write_tokens {
	my ($self, $p_Tokens) = @_;
	my $err = '';
	Err: {
		my $file = $self->{'TokenFile'};
		my $text = '';
		my ($name, $value) = ();
		while (($name, $value) = each %$p_Tokens) {
			next unless ($value =~ m!^(\d+)\,(.*)$!);
			my ($expires, $username) = ($1, $2);
			$text .= pack('A60LA64', $name, $expires, $username);
			}
		$err = &WriteFile($file, $text);
		next Err if ($err);
		&setchmod( $file );
		}
	return $err;
	}




sub SetDefaults {
	my ($text, $p_params) = @_;

	# short-circuit:
	if ((ref($p_params) ne 'HASH') or (not (%$p_params))) {
		return $text;
		}


	my @array = split(m!<(INPUT|SELECT|TEXTAREA)([^\>]+?)\>!is, $text);

	my $finaltext = $array[0];

	my $setval;

	my $x = 1;
	for ($x = 1; $x < $#array; $x += 3) {

		my ($uctag, $origtag, $attribs, $trail) = (uc($array[$x]), $array[$x], $array[$x+1] || '', $array[$x+2] || '');

		Tweak: {

			my $tag_name = '';
			if ($attribs =~ m! NAME\s*=\s*\"([^\"]+?)\"!is) {
				$tag_name = $1;
				}
			elsif ($attribs =~ m! NAME\s*=\s*(\S+)!is) {
				$tag_name = $1;
				}
			else {

				# we cannot modify what we do not understand:
				last Tweak;
				}
			last Tweak unless (defined($$p_params{$tag_name}));
			$setval = &he($$p_params{$tag_name});


			if ($uctag eq 'INPUT') {

				# discover VALUE and TYPE
				my $type = 'TEXT';
				if ($attribs =~ m! TYPE\s*=\s*\"([^\"]+?)\"!is) {
					$type = uc($1);
					}
				elsif ($attribs =~ m! TYPE\s*=\s*(\S+)!is) {
					$type = uc($1);
					}

				# discover VALUE and TYPE
				my $value = '';
				if ($attribs =~ m! VALUE\s*=\s*\"([^\"]+?)\"!is) {
					$value = $1;
					}
				elsif ($attribs =~ m! VALUE\s*=\s*(\S+)!is) {
					$value = $1;
					}

				# we can only set values for known types:

				if (($type eq 'RADIO') or ($type eq 'CHECKBOX')) {

					#changed 2001-11-15; strip pre-existing checks
					$attribs =~ s! (checked="checked"|checked)($| )!$2!ois;

					if ($setval eq $value) {
						$attribs = qq! checked="checked"$attribs!;
						}

					}
				elsif (($type eq 'TEXT') or ($type eq 'PASSWORD') or ($type eq 'HIDDEN')) {

					# but only hidden fields if value is null:

					last Tweak if (($type eq 'HIDDEN') and ($value ne ''));

					# replace any existing VALUE tag:
					my $qm_value = quotemeta($value);
					$attribs =~ s! value\s*=\s*\"$qm_value\"! value="$setval"!iso;
					$attribs =~ s! value\s*=\s*$qm_value! value="$setval"!iso;

					# add the tag if it's not present (i.e. if no VALUE was present in original tag)
					my $qm_setval = quotemeta($setval);
					unless ($attribs =~ m! VALUE="$qm_setval"!is) {
						$attribs = " value=\"$setval\"$attribs";
						}

					}
				}
			elsif ($uctag eq 'SELECT') {

# does not support <OPTION>value syntax, only <OPTION VALUE="value">value

				my $lc_set_value = lc($setval);

				my @frags = ();
				foreach (split(m!<option!is, $trail)) {

					#changed 2001-11-15; strip pre-existing "selected"
					$_ =~ s! (selected|selected="selected")($| )!$2!ois;

					if (m!VALUE\s*=\s*\"(.*?)\"!is) {
						if ($lc_set_value eq lc($1)) {
							$_ = ' selected="selected"' . $_;
							}
						}
					elsif (m!VALUE\s*=\s*(\S+)!is) {
						if ($lc_set_value eq lc($1)) {
							$_ = ' selected="selected"' . $_;
							}
						}
					push(@frags, $_);
					}
				$trail = join('<option', @frags);
				}
			elsif ($uctag eq 'TEXTAREA') {
				$trail =~ s!^.*?</(textarea)>!$setval</$1>!osi;
				}
			last Tweak;
			}

		$finaltext .= "<$origtag$attribs>$trail";
		}
	return $finaltext;
	}





=item parse_url

Usage:

	my ($clean_url, $host, $port, $path, $is_valid) = &parse_url( $url );

=cut

sub parse_url {
	local $_ = defined($_[0]) ? $_[0] : '';
	my ($clean_url, $host, $port, $path, $is_valid) = ('', '', 80, '/', 0);

	# add trailing slash if none present
	$_ .= '/' if (m!^http://([^/]+)$!i);

	if (m!^http://([\w|\.|\-]+)\:?(\d*)/(.*)$!i) {
		#changed 0009 - force $host to lowercase
		($host, $port, $path, $is_valid) = (lc($1), $2, clean_path("/$3"), 1);
		#end changes
		$port = 80 unless $port;

		if ($port == 80) {
			$clean_url = "http://$host$path";
			}
		else {
			$clean_url = "http://$host:$port$path";
			}
		}
	return ($clean_url, $host, $port, $path, $is_valid);
	}





=item clean_path($)

Function for stripping garbage from web page paths. It will collapse "." and
".." paths, collapse stacked /// slashes, and strip pound links.

Examples:

	"/foo/../bar/index.htm" => "/bar/index.htm"
	"/test.htm#top" => "/test.htm"
	"/../foo/bar" => "/foo/bar"
	"////top//level/../no_this/./file" => "/top/no_this/file"

This is used to cleanse links discovered in user input or in web pages that
crawler visits. It is also used to clean forbidden paths in the robots.txt
files (by cleaning both the original URL and the exclusion paths with the
same function, we minimize risk of hitting an exluded path.)

Dependencies:
	&Trim

=cut

sub clean_path {
	local $_ = &Trim($_[0]);

	# strip pound signs and all that follows (links internal to a page)
	s!\#.*$!!;

	# map /%7E to /~ (common source of duplicate URL's)
	s!\/\%7E!\/\~!ig;

	# map "/./" to "/"
	s!/+\./+!/!g;

	# map trailing "/." to "/"
	s!/+\.$!/!g;

	# map "/folder/../" => "/"
	while (s!([^/]+)/+\.\./+!/!) {}

	# map /../foo => /foo
	while (s!^/+\.\./+!/!) {}

	s!^/+\.\.$!/!;

	# collapse back-to-back slashes in the part before the query string:
	my ($path, $qs) = ($_, '');
	if (m!^(.*?)\?(.*)$!) {
		($path,$qs) = ($1,$2);
		}
	# collapse back-to-back slashes in the path
	$path =~ s!/+!/!g;

	$_ = $path;
	if ($qs ne '') {
		$_ .= "?$qs";
		}
	return $_;
	}




=item parse_url_ex

Usage:

	my ($err, $clean_url, $host, $port, $path) = &parse_url_ex( $url );

=cut

sub parse_url_ex {
	my ($clean_url, $host, $port, $path, $is_valid) = ();
	my $err = '';
	Err: {
		($clean_url, $host, $port, $path, $is_valid) = &parse_url(@_);
		unless ($is_valid) {
			$err = "URL must pattern match to 'http://host.tld/path/' - pattern '" . &he($_[0]) . "' failed";
			next Err;
			}
		last Err;
		}
	return ($err, $clean_url, $host, $port, $path);
	}

sub get_age_str {
	my ($age) = @_;
	my $age_str = '';
	$age += 59; # round up
	if ($age > (2 * 86400)) {
		$age_str = sprintf( '%s days ago', int($age / 86400) );
		}
	elsif ($age > (100 * 60)) {
		$age_str = sprintf( '%s hours ago', int($age / 3600) );
		}
	else {
		$age_str = sprintf( '%s minutes ago', int($age / 60) );
		}
	return $age_str;
	}








=item print_csv_format

Usage:
	($err, $row_count) = &print_csv_format( $sortf, $FORM{'cs'} );
	next Err if ($err);

Note that this subroutine will strip any ",", quote "", or newline \r, \n from the data. It does this so that the data will fit into the CSV format. It does this *instead* of escaping the code. Escape sequences are a TODO item.

=cut

sub print_csv_format($$$);
sub print_csv_format($$$) {
	my ( $sortf, $form_cs, $b_html ) = @_;
	my $row_count = 0;
	my $err = '';
	Err: {

		my $strip_this = "(\015|\012|\r|\n|\,|\")";

		unless (-s 'errors.log') {
			print "<p>The log is empty; there are no errors on file.</p>\n";
			last Err;
			}

		my %records = ();
		unless (open(FILE, "<errors.log")) {
			$err = "unable to open file 'errors.log' - $!";
			next Err;
			}
		binmode(FILE);
		while (defined($_ = <FILE>)) {
			my @fields = split(m!\t!s);
			$records{ $fields[$sortf] . $_ } = $_;
			}
		close(FILE);

		my $cs = $sortf;
		if ((defined($form_cs)) and ($form_cs == $sortf)) {
			$cs = 99;
			}

		my $i = 0;

		my ($b_limits, $u_limits, $h_limits) = (0, 0, 0);

		my @keys = ();

		# numeric sorts
		if (($sortf == 0) or ($sortf == 7) or ($sortf == 6)) {
			if ((defined($form_cs)) and ($form_cs == $sortf)) {
				@keys = sort {$a <=> $b}keys %records;
				}
			else {
				@keys = reverse sort {$a <=> $b}keys %records;
				}
			}
		else {
			if ((defined($form_cs)) and ($form_cs == $sortf)) {
				@keys = sort keys %records;
				}
			else {
				@keys = reverse sort keys %records;
				}
			}

		my $key;
		foreach $key (@keys) {

			$row_count++;

			# batch HTML-encode everything:
			local $_ = $records{$key};

			if ($b_html) {
				$_ = &he($_);
				}

			$i++;

			my @fields = split(m!\t!, $_);
			my %hash = ();

			my $x = 0;
			for ($x = 0; $x < $#DataFields; $x++) {
				$fields[$x] =~ s!$strip_this!!gs;
				$fields[$x] =~ s!&quot;!!gs if ($b_html);
				$hash{ $DataFields[$x] } = $fields[$x];
				}

			$hash{'HTTP_REFERER'} = '' unless ($hash{'HTTP_REFERER'});

			print qq!$hash{'TIME'},$hash{'LOCALTIME'},$hash{'REMOTE_HOST'},$hash{'REMOTE_ADDR'},$hash{'AG_ERROR_CODE'},$hash{'AG_ERROR_COUNT'},$hash{'AG_ERROR_URL'},$hash{'HTTP_REFERER'},$hash{'HTTP_USER_AGENT'},\015\012!;

			}
		last Err;
		}
	return ($err, $row_count);
	}









END_OF_CODE
eval $all_code;

if ($@) {
	my $errstr = $@;
	$errstr =~ s!\"!\&quot;!g;
	$errstr =~ s!\<!\&lt;!g;
	$errstr =~ s!\>!\&gt;!g;

print "Content-Type: text/html\015\012\015\012";
print <<"EOM";

<form method="post" action="http://www.xav.com/bug.pl" />
<input type="hidden" name="product" value="guardian" />
<input type="hidden" name="version" value="$VERSION" />
<input type="hidden" name="Perl Version" value="$]" />
<input type="hidden" name="Script Path" value="$0" />
<input type="hidden" name="Perl Error" value="$errstr" />

<hr />
<p><b>Perl Execution Error</b> in $0:</p>
<blockquote>
	<p>$errstr</p>
</blockquote>
<p>Please report this error to the script author:</p>
<blockquote>
	<p><input type="submit" value="Report Error" /></p>
</blockquote>
<hr />

EOM
	my ($name, $value);
	while (($name, $value) = each %FORM) {
		print qq!<input type="hidden" name="Form: $name" value="$value" />\n!;
		}
	print '</form>';
	}


1;
