#!/usr/local/bin/perl
$discus_conf = '/home/localhost/usr/local/share/apache/htdocs/ustelestar/discus/discus_admin_5998910083/discus.conf';
$pro_fileid = '256231955560';
$pro_license = '0011-2903-2914';
#-------------------------------------------------------------------------------
# DISCUS VERSION 3.10 COPYRIGHT NOTICE
#
# Discus 3.10 is copyright (c) 2000 by DiscusWare, LLC, all rights reserved.
# The use of Discus is governed by the Discus License Agreement which is
# available from the Discus WWW site at:
#    http://www.discusware.com/discus/license
#
# Pursuant to the Discus License Agreement, this copyright notice may not be
# removed or altered in any way.
#-------------------------------------------------------------------------------
$| = 1;
$D_release_version = "3.10";
$D_free_revision = "5";
$D_pro_revision = "5";
print "Content-type: text/html\n\n";
print "<HTML><HEAD><TITLE>Discus program diagnostics (version $D_release_version.$D_free_revision)</TITLE></HEAD>\n";
print "<BODY BGCOLOR=#ffffff TEXT=#000000 LINK=#0000ff VLINK=#800080>\n";
print "<FONT FACE=\"Verdana,Arial,Helvetica\" SIZE=2>\n";
print "<H3>Discus Program Diagnostics</H3>\n";
print "<HR SIZE=0>\n";
print "The following are the results of the Discus Program self-diagnostics.\n";
print "If you do not see any error messages, then the problem you are experiencing\n";
print "is likely not a problem with your setup.  You can always consult the\n";
print "<A HREF=\"http://www.discusware.com/support\" TARGET=_top>Discus Support Center</A>\n";
print "for support and troubleshooting assistance.  You may also wish to join us at the\n";
print "<A HREF=\"http://www.discusware.com/support/forum\" TARGET=_top>Discus Support Forum</A>\n";
print "if you need assistance.<P>\n";
print "Your platform is reported as: <B>", $^O, "</B>.<BR>\n";
print "This is <B>Discus ";
print "Pro " if $pro_license =~ m|^(\d{4})-(\d{4})-(\d{4})$|;
print "$D_release_version.$D_free_revision</B>.<BR>\n";
print "<HR SIZE=0></FONT>\n";
print "<PRE>\n";
print "\n<FONT COLOR=#0000aa><B><U>General program diagnostics</U></B></FONT>\n";
&prline("Checking for Perl 5.005 or higher");
$v = $];
if ($v < 5) {
	&prline(1);
	print "<!--PERL: $]-->";
	print "  Some features of Discus and Discus Pro require that you have Perl 5\n";
	print "  installed.  We have programmed Discus to be as backward compatible\n";
	print "  with Perl 4 as possible, but Perl 4 is buggy and isn't supported\n";
	print "  any more (it's several years old!).  If possible, you should have\n";
	print "  selected Perl 5 to use for the installation of Discus.  Your Perl\n";
	print "  version is $v, by the way.\n";
} else {
	if ($v < 5.005) {
		&prline(1);
		print "<!--PERL: $]-->";
		print "  Your Perl interpreter is version $], which is less than the 5.005\n";
		print "  supported by DiscusWare.  While we believe that most distributions\n";
		print "  of Perl 5.000 through 5.004 will work properly, it may interest you\n";
		print "  to know that Perl 5.004 was last updated in July of 1998 (more than\n";
		print "  3 years ago at the time of this writing).\n";
		print "  <b><a href=\"http://support.discusware.com/center/resources/faqs/perl.html\" target=\"_blank\">Please click here for further information</a></b>\n";
	} else {
		&prline(2);
		print "  Your Perl version is $]\n";
		print "<!--PERL: $]-->";
	}
}
if ($^O ne "MSWin32") {
	if (opendir(DIR, ".")) {
		while ($dir = readdir(DIR)) {
			if ($dir =~ m|^diagnose\.|) {
				open (FILE, "$dir");
				@file = <FILE>;
				close (FILE);
				chomp $file[0];
				$file[0] =~ s/^#!//;
				print "  Perl appears to be found at [", $file[0], "]";
			}
		}
		closedir(DIR);
	}
}
print "\n";
&prline("Checking \"crypt()\" function");
if (eval '$test = crypt("Foo", "Foo");') {
	&prline(2);
	print "<!--CRYPT: OK-->";
} else {
	&prline(1);
	print "<!--CRYPT: NO-->";
	print "<B>  Warning!  This port of Perl does not support 'crypt'!</B>\n";
	print "  <A HREF=\"http://www.discusware.com/cgi-bin/support/sc/checker4.cgi?19\">Click here for help</A>\n";
}
format XF =
@<<<<<<<<< @>> @<<<<<<< @<<<<<<< @>>>>>>> @<< @> @>:@> @<<<<<<<<<<<<<<<<<<<<<<<<<<
$mode,     $nlink, $uid2, $gid2, $size,   $mn,$dy,$hr,$min,$filename
.
$~ = "XF";
select (STDOUT);
# For the Discus Site Checker, but not for curious visitors!  We use this information when
# you request technical support from us.  Our script will access this page and get some more
# information about your board.  We also get some directory listings to help us pinpoint any
# problems you may be having much more precisely.  All of this information is treated
# confidentially and is not used for any purpose other than to help us provide the best
# support that we possibly can.  Note that we may refuse to provide support if you have disabled
# this portion of the script by editing it.
$discusware_employee = 0;
$discusware_employee = 1 if ($ENV{'REMOTE_ADDR'} eq "208.171.52.98");
$is_the_superuser = 0;
undef %uid;
eval '
	while (($name, $passwd, $uid) = getpwent) {
   		$uid{$uid} = $name;
	}
';
undef %gid;
eval '
	while (($name, $passwd, $gid) = getgrent) {
   		$gid{$gid} = $name;
	}
';
if ($discusware_employee) {
	print "\n\n<TABLE BGCOLOR=#ffffcc><TR><TD><PRE><FONT COLOR=#ff0000>DISCUSWARE EMPLOYEE SECTION</FONT>\n";
	print "  discus.conf location: $discus_conf\n";
	print "  License:              $pro_license\n";
	print "  Pro File ID:          $pro_fileid\n";
	print "  This user UID:        $> ($uid{$>})\n";
	print "  This user GID:        $) ($gid{$)})\n";
	print "\n";
	if (!-e "$discus_conf") {
		print "<FONT COLOR=#0000ff>DIRECTORY LISTINGS</FONT>\n";
		&dirlist(".");
		&dirlist("..");
		&dirlist("../../discus") if -e "../../discus";
		&dirlist("../../htdocs") if -e "../../htdocs";
		&dirlist("../../web") if -e "../../web";
		&dirlist("../..");
		print "\n<FONT COLOR=#0000ff>&quot;UP UNTIL&quot; DIRECTORY LISTINGS</FONT>\n\n";
		$dx = ""; $dc = $discus_conf;
		while ($dc =~ m|^(.*?)/|) {
			$dx .= "$1/"; $dc = $';
			&dirlist($dx);
		}
	}
	print "</PRE></TD></TR></TABLE>\n";
}
&prline("Checking discus.conf existence");
if (-e "$discus_conf") {
	&prline(2);
	&prline("Checking discus.conf readability");
	if (open(DC, "$discus_conf")) {
		&prline(2);
		print "<!--DC: OK-->";
	} else {
		&prline(1);
		print "Your discus.conf file is not readable.\n";
		print "Reason: <FONT COLOR=#ff0000>$!</FONT>\n" if $!;
		print "Check that permissions on discus.conf are set properly\n";
		print "to 0755 (rwxr-xr-x).  I think that's your problem!\n";
		print "<!--DC: NR-->";
		exit(0);
	}
	@file = <DC>;
	close (DC);
	&prline("Checking discus.conf uploaded in ASCII mode");
	if (grep(/\r/, @file) && $^O ne "MSWin32") {
		&prline(1);
		print "It looks like you uploaded discus.conf in binary or automatic mode.\n";
		print "Try uploading discus.conf in ASCII mode.\n";
		print "<!--DCM: BINARY-->\n";
		print "  <A HREF=\"http://www.discusware.com/cgi-bin/support/sc/checker4.cgi?15\">Click here for help</A>\n";
	} else {
		&prline(2);
		print "<!--DCM: OK-->";
	}
	foreach $line (@file) {
		if ($line =~ /^(\w+)=(.*)/) {
			$varname = $1;
			$value = $2;
			$value =~ s/\r//g;
			${$varname} = $value;
			print "<!-- Imported: $varname-->";
		}
	}
	&prline("Checking src-board-subs-common uploaded in ASCII mode");
	if (open(FILE, "< $admin_dir/source/src-board-subs-common")) {
		my @file = <FILE>;
		close (FILE);
		if (grep(/\r/, @file)) {
			&prline(1);
			print "  Your src-board-subs-common file is uploaded in binary mode.\n";
			print "  Please read: <a href=http://support.discusware.com/center/resources/errors/500diag.html target=_blank>this page</a>\n";
		} else {
			&prline(2);
		}
	} else {
		&prline(1);
		print "  Your src-board-subs-common file could not be opened.\n";
		print "  Error was: $!\n";
	}
	&prline("Importing src-board-subs-common subs");
	if (require "$admin_dir/source/src-board-subs-common") {
		&prline(2);
	} else {
		&prline(1);
		print "  Couldn't read in your src-board-subs-common file!\n";
		print "  Try re-uploading this file; make sure to use ASCII mode!\n";
		print "  Error: $!\n";
	}
	&prline("Importing src-board-subs-admin subs");
	if (require "$admin_dir/source/src-board-subs-admin") {
		&prline(2);
	} else {
		&prline(1);
		print "  Couldn't read in your src-board-subs-admin file!\n";
		print "  Try re-uploading this file; make sure to use ASCII mode!\n";
		print "  Error: $!\n";
	}
	$FORM{'username'} = $superuser;
	$x = &check_passwd(0, 0, 592);
	if ($x ne "-1") {
		$is_the_superuser = 1;
	}
	&prline("Checking existence of administration directory");
	if (-e($admin_dir)) {
		&prline(2);
		print "<!--AD: OK-->";
		&prline("Checking existence of source directory");
		if (-e("$admin_dir/source")) {
			&prline(2);
			print "<!--SRD: OK-->";
			undef @needed_src;
			for ($i = 1; $i <= 20; $i++) {
				push (@needed_src, "src-board-subs-$i");
			}
			push (@needed_src, "src-board-subs-common");
			push (@needed_src, "src-board-subs-admin");
			push (@needed_src, "dep.txt");
			if ($pro) {
				for ($i = 100; $i <= 106; $i++) {
					push (@needed_src, "src-board-subs-$i");
				}
			}
			push (@needed_src, "src-board-subs-smtp");
			push (@needed_src, "src-board-subs-win32");
			push (@needed_src, "src-board-subs-spch");
			$errors = 0;
			foreach $file (@needed_src) {
				&prline("Checking source file $file");
				if ($file =~ m|src-board-subs-10(\d)|) {
					$dir = join("_", $file, $pro_fileid);
				} else {
					$dir = $file;
				}
				if (open(SRC, "$admin_dir/source/$dir")) {
					@src = <SRC>;
					close (SRC);
					if (grep(/\r/, @src) && $^O ne "MSWin32") {
						&prline(1); $errors += 1;
						print "  $admin_dir/source/$file was not uploaded in ASCII mode\n";
					} else {
						&prline(2);
					}
				} else {
					&prline(1); $errors += 1;
					print "  $admin_dir/source/$file is not readable\n";
					print "  <FONT COLOR=#ff0000>$!</FONT>\n" if $!;
				}
			}
			if ($errors) {
				print "<!--SRF: DNE-->";
			} else {
				print "<!--SRF: OK-->";
			}
		} else {
			&prline(1);
			print "  $admin_dir/source directory doesn't exist! :(\n";
			print "  <A HREF=\"http://www.discusware.com/cgi-bin/support/sc/checker4.cgi?14\">Click here for help</A>\n";
			print "<!--SRD: DNE-->";
		}
	} else {
		&prline(1);
		print "  $admin_dir directory doesn't exist!</B>\n";
		print "<!--AD: DNE-->";
	}
	&prline("Checking existence of HTML directory");
	if (-e($html_dir)) {
		&prline(2);
		print "<!--HD: OK-->";
	} else {
		&prline(1);
		print "  <A HREF=\"http://www.discusware.com/cgi-bin/support/sc/checker4.cgi?15\">Click here for help</A>\n";
		print "<!--HD: DNE-->";
	}
	&prline("Checking existence of script directory");
	if (-e($script_dir)) {
		&prline(2);
		print "<!--SD: OK-->";
	} else {
		&prline(1);
		print "  <A HREF=\"http://www.discusware.com/cgi-bin/support/sc/checker4.cgi?16\">Click here for help</A>\n";
		print "<!--SD: DNE-->\n";
	}
	if ($^O eq "MSWin32") {
		print "<!--PLATFORM: WIN-->";
	} else {
		print "<!--PLATFORM: UNIX-->";
	}
	require "$admin_dir/source/src-board-subs-common" || print "<!--Could not require src-board-subs-common $!-->\n";
	eval '&parse_form;';
	&prline("Checking Discus version match");
	if ($D_release_version ne $release_version || $free_revision ne $D_free_revision || $pro_revision ne $D_pro_revision) {
		&prline(1);
		print "<!--VERSION MISMATCH-->\n";
		print "<UL><FONT SIZE=4 COLOR=#ff0000><B>VERSION MISMATCH</B></FONT>\n";
		print "Your script files are version $D_release_version.$D_pro_revision/$D_release_version.$D_free_revision\n";
		print "Your source files are version $release_version.$pro_revision/$release_version.$free_revision\n";
		print "</UL>";
	} else {
		&prline(2);
	}
	&prline("Checking topics file existence");
	if (-e "$message_dir/$board_topics_file") {
		&prline(2);
	} else {
		&prline(1);
		print "Board topics file ($board_topics_file) does not exist!\n";
	}
	&prline("Checking topics file permissions");
	if (-w "$message_dir/$board_topics_file") {
		&prline(2);
	} else {
		&prline(1);
		print "Board topics file ($board_topics_file) is not writable!\n";
	}
	if (open(FILE, "$message_dir/$board_topics_file")) {
		&prline("Checking topics file integrity");
		$tmp = $/;
		undef $/;
		$file = <FILE>;
		close (FILE);
		$/ = $tmp;
		if ($file =~ m|\r|) {
			&prline(1);
			print "Board topics file uploaded in binary mode!\n";
		} else {
			&prline(2);
		}
	}
	if ($pro == 1) {
		print "<FONT COLOR=#00aaaa><B>This installation is configured as DISCUS PRO</B></FONT>\n";
	} else {
		print "<FONT COLOR=#00aaaa><B>This installation is configured as DISCUS FREEWARE</B></FONT>\n";
	}
	print "\n<FONT COLOR=#0000aa><B><U>Verifying file permissions</U></B></FONT>\n";
	opendir(DIR, "$admin_dir") || print "  <FONT COLOR=#ff0000>Could not list files in administration directory!<BR>  Reason: <B>$!</B><P></FONT>";
	while ($dir = readdir(DIR)) {
		next if $dir !~ m|\.txt$|;
		&prline("Administration directory: $dir");
		if (-w "$admin_dir/$dir") {
			if (open (FILE, "$admin_dir/$dir")) {
				@file = <FILE>;
				close (FILE);
				if (grep(/\r/, @file)) {
					&prline(1);
					print "  This file is uploaded in binary mode -- USE DATA RECOVERY!\n";
				} else {
					&prline(2);
				}
			} else {
				&prline(1);
				print "  Could not read file -- VERY WEIRD PERMISSIONS PROBLEM!\n";
			}
		} else {
			&prline(1);
			print "  This file is not writable to the web server -- PERMISSIONS PROBLEM!\n";
		}
	}
	closedir(DIR);
	@subdir = ('backups', 'locks', 'msg_index');
	if ($pro) {
		push (@subdir, 'queue', 'secure', 'profiles');
	}
	foreach $dir (sort(@subdir)) {
		&prline("Administration subdirectory: $dir (rwxrwxrwx)");
		if (-w "$admin_dir/$dir") {
			&prline(2);
		} else {
			&prline(1);
		}
	}
	opendir(DIR, "$admin_dir/msg_index") || print "  <FONT COLOR=#ff0000>Could not list files in msg_index directory!<BR>  Reason: <B>$!</B><P></FONT>";
	while ($dir = readdir(DIR)) {
		next if $dir !~ m|\.txt$|;
		&prline("msg_index directory: $dir (rwxrwxrwx)");
		if (-w "$admin_dir/msg_index/$dir") {
			&prline(2);
		} else {
			&prline(1);
		}
	}
	closedir(DIR);
	opendir(DIR, "$admin_dir/msg_index") || print "  <FONT COLOR=#ff0000>Could not list files in msg_index directory!<BR>  Reason: <B>$!</B><P></FONT>";
	while ($dir = readdir(DIR)) {
		next if ($dir !~ m|^\d+$| && $dir ne "searches");
		&prline("msg_index subdirectory: msg_index/$dir (rwxrwxrwx)");
		if (-w "$admin_dir/msg_index/$dir") {
			&prline(2);
		} else {
			&prline(1);
		}
	}
	closedir(DIR);
	&prline("Messages directory (rwxrwxrwx)");
	if (-w "$message_dir") {
		&prline(2);
	} else {
		&prline(1);
	}
	print "\n<FONT COLOR=#0000aa><B><U>Checking integrity of scripts/source files</U></B></FONT>\n";
	opendir(DIR, "$admin_dir/source");
	$fileid = $pro_fileid;
	while ($dir = readdir(DIR)) {
		if ($dir =~ m|dep|) {
			open (FILE, "$admin_dir/source/$dir");
			@file = <FILE>;
			close (FILE);
			&prline("Dependency file: dep.txt");
			if (grep(/^# END - FILE IS CORRECTLY UPLOADED #/, @file)) {
				if (grep(/\r/, @file) && $^O ne "MSWin32") {
					&prline(1);
					print "  File is uploaded in binary mode.\n";
				} else {
					&prline(2);
				}
			} else {
				&prline(1);
				print "  File is not completely uploaded.\n";
			}
		}
		next if $dir !~ m|^src-board-subs-|;
		open (FILE, "$admin_dir/source/$dir");
		@file = <FILE>;
		close (FILE);
		if ($dir =~ m|src-board-subs-1(\d)(\d)_$fileid|) {
			$f = "src-board-subs-1$1$2";
		} elsif ($dir =~ m|src-board-subs-1(\d)(\d)_(\d+)|) {
			next;
		} else {
			$f = $dir;
		}
		$checksum = 0;
		foreach $line (@file) {
			next if $line !~ m|\S|;
			$linetemp = $line;
			$linetemp =~ s/\s//g;
			$checksum += length($linetemp);
		}
		&prline("Source file: $f");
		print "<!--Checksum: $checksum-->";
		if (grep(/^# END - FILE IS CORRECTLY UPLOADED #/, @file) || grep(m|^// END - FILE IS CORRECTLY UPLOADED #|, @file)) {
			if (grep(/\r/, @file) && $^O ne "MSWin32") {
				&prline(1);
				print "  File is uploaded in binary mode.\n";
			} else {
				&prline(2);
			}
		} else {
			&prline(1);
			print "  File is not completely uploaded.\n";
		}
	}
	closedir(DIR);
	opendir(DIR, "$script_dir");
	while ($dir = readdir(DIR)) {
		next if $dir !~ m|\.$cgi_extension$|;
		next if $dir eq "board-setup.$cgi_extension";
		next if $dir eq "cookie.$cgi_extension";
		next if $dir =~ m|^ftpdiag\.|;
		open (FILE, "$script_dir/$dir");
		@file = <FILE>;
		close (FILE);
		$checksum = 0;
		foreach $line (@file) {
			next if $line =~ m|^#!|;
			next if $line =~ m|^\$discus_conf|;
			next if $line =~ m|^\$pro_fileid|;
			next if $line =~ m|^\$pro_license|;
			$linetemp = $line;
			$linetemp =~ s/\s//g;
			next if $linetemp !~ m|\S|;
			$checksum += length($linetemp);
		}
		&prline("Script file: $dir");
		print "<!--Checksum: $checksum-->";
		if (grep(/^# END - FILE IS CORRECTLY UPLOADED #/, @file)) {
			if (grep(/\r/, @file) && $^O ne "MSWin32") {
				&prline(1);
				print "  File is uploaded in binary mode.\n";
			} else {
				&prline(2);
			}
		} else {
			&prline(1);
			print "  File is not completely uploaded.\n";
		}
	}
	closedir(DIR);
	$fntemp = join("", time, $$); $fntemp =~ s/\W//g; $fntemp .= ".TMP";
	foreach $ll ("locks", "backups") {
		&prline("Permissions: Create '$ll' file");
		if (open(FILE, ">$admin_dir/$ll/$fntemp")) {
			&prline(2);
			close (FILE);
			&prline("Permissions: Remove '$ll' file");
			if (unlink("$admin_dir/$ll/$fntemp")) {
				&prline(2);
			} else {
				&prline(1);
				print "  Error was: <I>$!</I>\n";
				if ($! =~ m|Permission|i && $^O eq "MSWin32") {
					print "  With a permissions problem, you need to check\n";
					print "  that access privileges are set to 'FULL' for the\n";
					print "  WWW server if you're on an NT or Win2000 system!\n";
				}
			}
		} else {
			&prline(1);
			print "  Error was: <I>$!</I>\n";
		}
	}
	print "\n<FONT COLOR=#0000aa><B><U>Checking status of installed Perl modules</U></B></FONT></PRE>\n";
	print "<ul><table bgcolor=#ffcccc width=80%><tr><td><p><b>IMPORTANT!</b></p><p>The following section tests the installation of several optional\n";
	print "Perl modules on your system.  If a module is not installed and you wish to\n";
	print "use the functionality made available by that module, then you must\n";
	print "download and install that module.  This section of diagnostics tests\n";
	print "the configuration of your server and is NOT in any way a problem with\n";
	print "the Discus software.  Therefore, any reports to DiscusWare of messages\n";
	print "indicating modules are not installed will be IGNORED.\n\n";
	print "For assistance, please read the following document in the Discus\n";
	print "Knowledge Center: <A HREF=http://www.discusware.com/support/resources/help/modules.html TARGET=_blank>CLICK HERE FOR AN EXPLANATION OF THIS SECTION</a>\n";
	print "\n</td></tr></table></ul>\n<pre>";
	&prline("* Net::SMTP module");
	eval 'use Net::SMTP;';
	if ($@ ne "") {
		&prline(3);
	} else {
		&prline(4);
	}
	&prline("* Mail::Sendmail module");
	eval 'use Mail::Sendmail;';
	if ($@ ne "") {
		&prline(3);
	} else {
		&prline(4);
	}
	if ($pro) {
		&prline("* Compress::Zlib module");
		eval 'use Compress::Zlib;';
		if ($@ ne "") {
			&prline(3);
		} else {
			&prline(4);
		}
	}
	if ($^O eq "MSWin32"	) {
		&prline("* Win32::Process module");
		eval 'use Win32::Process;';
		if ($@ ne "") {
			&prline(3);
		} else {
			&prline(4);
		}
	}
	if ($discusware_employee || $is_the_superuser) {
		print "\n\n<TABLE BGCOLOR=#ffffcc><TR><TD><PRE><FONT COLOR=#ff0000>DISCUSWARE EMPLOYEE SECTION</FONT>\n" if $discusware_employee;
		print "\n\n<TABLE BGCOLOR=#ffffcc><TR><TD><PRE><FONT COLOR=#ff0000>BOARD ADMINISTRATOR SECTION</FONT>\n" if $is_the_superuser;
	}
	if ($discusware_employee) {
		print "<!--LICENSE: $pro_license-->License: $pro_license\n";
		print "<!--PRO: $pro-->\n";
		print "<!--TITLE: $title-->\n";
		print "<!--CONTACT: $contact-->\n";
		print "<!--URL: $html_url-->\n";
		eval '($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = stat "$html_dir";';
		print "<!--UID: $uid-->HTML dir UID:      $uid  \n";
		print "<!--GID: $gid-->HTML dir GID:      $gid  \n";
		print "<!--CTIME: $ctime-->HTML dir created:  $ctime  \n";
		print "<!--MTIME: $mtime-->HTML dir modified: $mtime  \n";
		print "<!--ATIME: $atime-->HTML dir accessed: $atime  \n";
		print "<B>Begin discus.conf file:</B>\n";
		open (DISCUSCONF, "$admin_dir/discus.conf");
		while (<DISCUSCONF>) {
			print;
		}
		close (DISCUSCONF);
		print "<B>End discus.conf file.</B>\n";
		print "<B>Begin email.txt file:</B>\n";
		open (DISCUSCONF, "$admin_dir/email.txt");
		while (<DISCUSCONF>) {
			print;
		}
		close (DISCUSCONF);
		print "<B>End email.txt file.</B>\n";
		eval 'print "<!--UID: $>-->Server UID:        $>\n";';
		eval 'print "<!--GID: $)-->Server GID:        $)\n";';
		open (DATA, "$admin_dir/data.txt"); @data = <DATA>; close (DATA);
		$data = $data[0]; chomp $data;
		print "<B>Testing data.txt file writing ability...</B>\n";
		print "Page counter before write (data.txt) -- $data\n";
		$DIAGNOSTICS = 1 if $FORM{'perform_diagnostics'};
		&ex('get_number', 1);
		open (DATA, "$admin_dir/data.txt"); @data = <DATA>; close (DATA);
		$data = $data[0]; chomp $data;
		print "Page counter after write (data.txt) -- $data\n";
		open (POSTINDEX, "$admin_dir/postindex.txt"); @data = <POSTINDEX>; close (POSTINDEX);
		$data = $data[0]; chomp $data;
		print "Post counter (postindex.txt) -- $data\n";
		print "<b>Global Options</b>\n";
		foreach $key (sort keys(%GLOBAL_OPTIONS)) {
			print "$key = '$GLOBAL_OPTIONS{$key}'\n";
		}
		print "\n\n";
		opendir(DIR, "$admin_dir/msg_index");
		$count = 0; $lasttime = 0; $topics = 0; $lasttime_topic = 0;
		while ($dir = readdir(DIR)) {
			next if $dir !~ m|-log.txt$|;
			$topics += 1;
			$count_topic = 0; $lasttime_topic = 0;
			open (FILE, "$admin_dir/msg_index/$dir");
			while (<FILE>) {
				@c = split(/;/, $_);
				if ($c[2] > $lasttime) {
					$lasttime = $c[2];
				}
				if ($c[2] > $lasttime_topic) {
					$lasttime_topic = $c[2];
				}
				$count += 1;
				$count_topic += 1;
			}
			close (FILE);
			print "<!--TOPIC: $count_topic $lasttime_topic-->\n";
		}
		closedir(DIR);
		print "<!--SUMMARY: $count $lasttime-->\n";
		print "<!--VERSION: $release_version $free_revision $pro_revision-->\n";
		print "<B>Error Log:</B>\n";
		open (ERRORS, "$admin_dir/errors.txt");
		while (<ERRORS>) {
			print;
		}
		close (ERRORS);
		print "<!-- End Error Log -->\n";
	}
	if ($is_the_superuser || $discusware_employee) {
		print "\n<FONT COLOR=#0000ff>DIRECTORY LISTINGS</FONT>\n";
		print "<FONT COLOR=#ff0000>Displayed because you are the board administrator</FONT>\n" if $is_the_superuser;
		print "\n" if $discusware_employee;
		if ($^O eq "MSWin32") {
			print "NOTE: On Windows, the permissions and user/group information may be\n";
			print "meaningless or misleading.\n\n";
		}
		&dirlist("$admin_dir");
		&dirlist("$admin_dir/backups");
		&dirlist("$admin_dir/locks");
		&dirlist("$admin_dir/msg_index");
		if ($pro) {
			&dirlist("$admin_dir/profiles");
			&dirlist("$admin_dir/queue");
			&dirlist("$admin_dir/secure");
		}
		&dirlist("$admin_dir/source");
		&dirlist("$admin_dir/..");
		&dirlist("$html_dir");
		&dirlist("$html_dir/..");
		&dirlist("$message_dir");
		print "</PRE></TD></TR></TABLE>\n";
	} else {
		opendir(DIR, "$admin_dir/msg_index");
		$count = 0; $lasttime = 0; $topics = 0; $lasttime_topic = 0;
		while ($dir = readdir(DIR)) {
			next if $dir !~ m|-log.txt$|;
			$topics += 1;
			$count_topic = 0; $lasttime_topic = 0;
			open (FILE, "$admin_dir/msg_index/$dir");
			while (<FILE>) {
				@c = split(/;/, $_);
				if ($c[2] > $lasttime) {
					$lasttime = $c[2];
				}
				if ($c[2] > $lasttime_topic) {
					$lasttime_topic = $c[2];
				}
				$count += 1;
				$count_topic += 1;
			}
			close (FILE);
			print "<!--TOPIC: $count_topic $lasttime_topic-->";
		}
		closedir(DIR);
		print "<!--SUMMARY: $count $lasttime-->";
	}
	print "\n<FONT COLOR=#0000aa><B><U>Checking Icons</U></B></FONT>\n";
	print "You should see a folder icon here ----&gt; <IMG SRC=\"$html_url/icons/tree_g.gif\">\n";
	print "    If you do not see it, <A HREF=\"http://www.discusware.com/support\">click here</A> to go";
	print " to the Discus Support Center and\n    do a search for 'Why does Discus not display the icons properly?' with";
	print " the\n    provided search tool.\n\n";
	print "Your Discus version is <B>$release_version";
	print ".$free_revision FREE" if !$pro;
	print ".$pro_revision PRO" if $pro;
	print " ($DISCUS_release_date)</B>\n";
	print "\n<FONT COLOR=#0000aa><B><U>Checking Individual Subroutines</U></B></FONT>\n";
	for ($i = 1; $i <= 20; $i += 1) {
		$tmp = $/; $/ = "#---SEPARATOR---#";
		if (open(FILE, "$admin_dir/source/src-board-subs-$i")) {
			@file = <FILE>;
			close (FILE);
			$x = shift(@file);
			while ($m = shift(@file)) {
				@l = split(/\n/, $m);
				@l = grep(/\S/, @l);
				@l = grep(!/^\s*#/, @l);
				$m = join("\n", @l);
				$y = "0$i" if $i < 10;
				$y = $i if $i >= 10;
				if ($m =~ m|sub (\w+)\s*\{|) {
					&prline("($y) $1");
					eval $m;
					if ($@) {
						&prline(1);
						print " Error was: $@\n";
					} else {
						&prline(2);
					}
				}
			}
		} else {
			print "ERROR: Could not open src-board-subs-$i: $!\n";
		}
		$/ = $tmp;
	}
	if ($pro) {
		for ($i = 100; $i <= 106; $i += 1) {
			$tmp = $/; $/ = "#---SEPARATOR---#";
			$fn = "src-board-subs-$i" . "_$pro_fileid";
			if (open(FILE, "$admin_dir/source/$fn")) {
				@file = <FILE>;
				close (FILE);
				$x = shift(@file);
				while ($m = shift(@file)) {
					@l = split(/\n/, $m);
					@l = grep(/\S/, @l);
					@l = grep(!/^#/, @l);
					$m = join("\n", @l);
					$y = "0$i" if $i < 10;
					$y = $i if $i >= 10;
					if ($m =~ m|sub (\w+)\s*\{|) {
						&prline("($y) $1");
						eval $m;
						if ($@) {
							&prline(1);
							print " Error was: $@\n";
						} else {
							&prline(2);
						}
					}
				}
			} else {
				print "ERROR: Could not open src-board-subs-$i: $!\n";
			}
			$/ = $tmp;
		}
	}
	print "\nEnd diagnostics.\n\n";
	print "<!-- Additional Helpful Information:\n";
	print "  HTTP_COOKIE       = '$ENV{'HTTP_COOKIE'}'\n";
	print "  SERVER_SOFTWARE   = '$ENV{'SERVER_SOFTWARE'}'\n";
	print "  \$0                = '$0'\n";
	print "  \$^T               = '$^T'\n";
	print "  \$^X               = '$^X'\n";
	if (open(DIAGNOSE, "./diagnose.$cgi_extension")) {
		@diag = <DIAGNOSE>;
		close (DIAGNOSE);
		$perl = $diag[0]; chomp $perl;
		print "  Perl from top     = '$perl'\n";
	} else {
		print "  Diagnose:  Could not open ($!)\n";
	}
	print "  Now the time is   = '", time, "'\n";
	print "-->\n\n";
	if ($^O ne "MSWin32" && ($is_the_superuser || $discusware_employee)) {
		print "\n<FONT COLOR=#0000ff>ADDITIONAL SERVER INFORMATION</FONT>\n";
		print "<FONT COLOR=#ff0000>Displayed because you are the board administrator</FONT>\n" if $is_the_superuser;
		print "\n" if $discusware_employee;
		print "<TABLE BGCOLOR=#ccccff WIDTH=100%><TR><TD><PRE>\n";
		&command("w");
		&command("ps");
		&command("ps -au");
		&command("ps -aux");
		&command("ps -Af");
		print "</PRE></TD></TR></TABLE>\n";
	}
	print "</BODY></HTML>\n";
	exit(0);
}
sub command {
	my ($cmd) = @_;
	print "system%  <B>$cmd</B>\n\n";
	system($cmd);
	print "\n";
}
#-------------------------------------------------------------------------------
#-------------------------------------------------------------------------------
# discus.conf is wrong
# You probably get a Script Execution Error from scripts
&prline(1);
print "\n";
print "You probably get a 'Script Execution Error' from the rest of the Discus\n";
print "scripts.  Please wait while I attempt to find and fix the error...\n\n";
flush();
print "<b>Step 1:</b> Locating this script\n";
my $prog = $0;
print "   This script's name is:  $prog\n";
if ($prog =~ m|diagnose\.(\w+)$|) {
	$before_path = $`; $cgi_ext = $1; $before_path =~ s/\/+$//;
} else {
	print "Your Perl interpreter does not set the \$0 variable.\n";
	print "You need a properly working Perl interpreter to run Discus.\n";
	exit(0);
}
print "   CGI extension is: $cgi_ext\n";
$full_path = "";
$full_path = check_full_path($before_path, $cgi_ext, $full_path) if $before_path;
if ($^O ne "MSWin32") {
	$pwd = `pwd`; chomp $pwd;
	$full_path = check_full_path($pwd, $cgi_ext, $full_path) if $pwd;
}
if (!eval 'use Cwd;') {
    eval '$cwd = cwd();';
    $full_path = check_full_path($cwd, $cgi_ext, $full_path) if $cwd;
}
$full_path = check_full_path($ENV{'SCRIPT_FILENAME'}, $cgi_ext, $full_path) if $ENV{'SCRIPT_FILENAME'};
$full_path = check_full_path($ENV{'PATH_TRANSLATED'}, $cgi_ext, $full_path) if $ENV{'PATH_TRANSLATED'};
print "   Full path to this script: $full_path\n";
if (! $full_path) {
	print "Sorry, but diagnostics couldn't find this script.  Your problem cannot\n";
	print "be fixed automatically.\n";
	exit(0);
}
print "<b>Step 2.</b> Finding discus.conf file\n";
flush();
my $dc = $discus_conf;
$dc =~ s/\/discus\.conf$//;
my $dc2 = $dc;
my $s2 = ( $dc2 =~ s%/%%g );
$actual_discus_conf = "";
$i = $full_path; my $s1 = ( $i =~ s%/%%g );
O: for (my $j = 0; $j <= $s1; $j += 1) {
	my $fpt = $full_path;
	if ($fpt =~ s%((/[^/]+){$j})$%%) {
		$fpt = "/" if $fpt eq "";
		I: for (my $q = 0; $q <= $s2; $q += 1) {
			my $dct = $dc;
			if ($dct =~ s%^((/[^/]+){$q})%%) {
				$dct = "/" if $dct eq "";
				my $k = join("/", $fpt, $dct, "discus.conf");
				$k =~ s%/+%/%g;
				print "   Trying $k: ";
				if (-e "$k") {
					print "Success!\n";
					$actual_discus_conf = "$k";
					last O;
				} else {
					print "No\n";
				}
			}
		}
		I: for (my $q = 0; $q <= $s2; $q += 1) {
			my $dct = $dc;
			if ($dct =~ s%((/[^/]+){$q})$%%) {
				$dct = "/" if $dct eq "";
				my $k = join("/", $fpt, $dct, "discus.conf");
				$k =~ s%/+%/%g;
				print "   Trying $k: ";
				if (-e "$k") {
					print "Success!\n";
					$actual_discus_conf = "$k";
					last O;
				} else {
					print "No\n";
				}
			}
		}
	}
}
if (! $actual_discus_conf) {
	print "\nSorry, I couldn't find your discus.conf file\n";
	print "Please consult the following support document(s) for assistance:\n";
	print "   <a href=http://support.discusware.com/center/resources/errors/see.html target=_blank>Script Execution Error</a>\n";
	print "   <http://support.discusware.com/center/resources/howto/see_move.html target=_blank>Fixing a Script Execution Error if directory paths were changed</a>\n";
	exit(0);
}
print "<b>Step 3.</b>  Reading your discus.conf file\n";
my $DC = {};
if (open(FILE, "< $actual_discus_conf")) {
	while (<FILE>) {
		if (m|^(\w+)=(.*)|) {
			my ($k1, $k2) = ($1, $2);
			$k2 =~ s/\r//g;
			$DC->{$k1} = $k2;
			$k2 =~ s/(\W)/join("", "&#", ord($1), ";")/ge;
			print "   '$k1' = '$k2'\n";
		}
	}
} else {
	print "   Your discus.conf file couldn't be opened: $!\n";
	exit(0);
}
print "<b>Step 4.</b>  Finding your HTML directory\n";
print "   Trying discus.conf setting ($DC->{html_dir}): ";
$html_dir_real = check_html_path($DC->{html_dir}, "");
if ($html_dir_real) {
	print "Success!\n";
} else {
	print "No.\n";
	for (my $w = 1; $w <= length($actual_discus_conf); $w += 1) {
		if (substr($DC->{html_dir}, 0, $w) ne substr($DC->{admin_dir}, 0, $w)) {
			$x = quotemeta(substr($DC->{html_dir}, 0, $w-1));
			$j = $DC->{html_dir}; $j =~ s/^$x//;
			$k = $DC->{admin_dir}; $k =~ s/^$x//;
			$l = quotemeta($k); $dct = $actual_discus_conf;
			$dct =~ s/$l//;
			$dct =~ s/\/discus\.conf$//;
			$bg = join("/", $dct, $j);
			$bg =~ s%/+%/%g;
			last;
		}
	}
	if ($bg ne "") {
		print "   Trying best guess ($bg): ";
		$html_dir_real = check_html_path($bg, $html_dir_real);
		if ($html_dir_real) {
			print "Success!\n";
		} else {
			print "No.\n";
		}
	}
	if (! $html_dir_real) {
		my $dd = $DC->{html_dir};
		my $s3 = ( $dd =~ s%/%%g );
		my $dc = $DC->{html_dir};
		O: for (my $j = 0; $j <= $s1; $j += 1) {
			my $fpt = $full_path;
			if ($fpt =~ s%((/[^/]+){$j})$%%) {
				$fpt = "/" if $fpt eq "";
				I: for (my $q = 0; $q <= $s2; $q += 1) {
					my $dct = $dc;
					if ($dct =~ s%^((/[^/]+){$q})%%) {
						$dct = "/" if $dct eq "";
						my $k = join("/", $fpt, $dct);
						$k =~ s%/+%/%g;
						print "   Trying $k: ";
						if (-e "$k/messages/board-topics.html") {
							print "Success!\n";
							$html_dir_real = "$k";
							last O;
						} else {
							print "No\n";
						}
					}
				}
				I: for (my $q = 0; $q <= $s3; $q += 1) {
					my $dct = $dc;
					if ($dct =~ s%((/[^/]+){$q})$%%) {
						$dct = "/" if $dct eq "";
						my $k = join("/", $fpt);
						$k =~ s%/+%/%g;
						print "   Trying $k: ";
						if (-e "$k/messages/board-topics.html") {
							print "Success!\n";
							$html_dir_real = "$k";
							last O;
						} else {
							print "No\n";
						}
					}
				}
			}
		}
	}
}
if (! $html_dir_real) {
	print "\nSorry, I couldn't find your HTML directory.\n";
	exit(0);
}
$html_dir_real =~ s/\/+$//;
print "<form action='http://www.discusware.com/cgi-bin/discus/ftp/ftp-inst.cgi' Method='Post' Target='_blank'>\n";
print "<b>Step 5.</b>  Calculating correct parameters\n";
my $dco1 = "";
foreach my $i (keys(%{ $DC })) {
	my $l = join("=", $i, $DC->{$i});
	$l .= "\n";
	$l =~ s/([^\w ])/sprintf("%%%02lx", ord($1))/eg;
	$l =~ tr/ /+/;
	$dco1 .= $l;
}
print "<input type=hidden name=orig_discus_conf value='$dco1'>\n";
$actual_discus_conf =~ s%/discus\.conf$%%;
$DC->{admin_dir} = $actual_discus_conf;
print "   admin_dir = '$DC->{admin_dir}'\n";
$DC->{html_dir} = $html_dir_real;
print "   html_dir = '$DC->{html_dir}'\n";
$DC->{script_dir} = $full_path;
print "   script_dir = '$DC->{script_dir}'\n";
print "<b>Step 6.</b> Allowing you to correct the problem\n";
print "\n";
print "<font color=#0000ff><B>INSTRUCTIONS:</B> This section will allow you to correct the problem with\n";
print "your setup to avoid the 'Script Execution Error' message you see when you\n";
print "access your scripts.\n\n";
print "1.  Click the 'Generate' button to generate an FTP distribution.\n\n";
print "2.  Download the distribution to your computer and open the readme.html file.\n\n";
print "3.  Upload these files:\n";
print "    - discus.conf (to your administration directory)\n";
print "    - src-board-subs-* files (to your source directory)\n";
print "    - *.$cgi_ext files (to your scripts directory)\n";
print "\n";
print "    In this step, you should be uploading these files to directories you created\n";
print "    the first time you ran setup.  If this is not the case, you are doing something\n";
print "    wrong!\n\n";
print "4.  Go to your board at:\n";
print "        <a href=$DC->{html_url} target=_blank>$DC->{html_url}</a>\n";
print "    Test the scripts to ensure that the 'Script Execution Error' is gone\n";
print "    and that your board works properly.  Follow instructions in the readme.html\n";
print "    file to set up your initial password, register Discus, etc.\n\n";
print "5.  Check your diagnostics for other problems.  Do this by simply hitting 'Reload'\n";
print "    on this page.\n";
print "\n";
print "Thank you for choosing Discus.</font></pre>\n";
print "<p>\n";
print "<input type=hidden name='diagnose' value='1'>\n";
print "<input type=hidden name='escaped' value='1'>\n";
print "<input type=hidden name='discusconf' value='";
my $dco = "";
foreach my $i (keys(%{ $DC })) {
	my $l = join("=", $i, $DC->{$i});
	$l .= "\n";
	$l =~ s/([^\w ])/sprintf("%%%02lx", ord($1))/eg;
	$l =~ tr/ /+/;
	$dco .= $l;
}
print "$dco'>\n";
print "<input type=hidden name='pathperl' value='$pathperl'>\n";
print "<INPUT TYPE=HIDDEN NAME=action VALUE=upgrade>\n";
print "<INPUT TYPE=HIDDEN NAME=version_requested VALUE=3_10>\n";
if ($DC->{pro}) {
	print "<INPUT TYPE=HIDDEN NAME=pro_license VALUE='$pro_license'>\n";
	print "<INPUT TYPE=HIDDEN NAME=get_pro VALUE=1>\n";
}
print "<ul><input type=submit value='Generate'></ul></form></body></html>\n";
exit(0);
sub check_full_path {
	my ($path, $cgi_ext, $full_path) = @_;
	return $full_path if $full_path;
	$full_path =~ s%\\%/%g;
	$full_path =~ s%/+%/%g;
	if (-e "$path/diagnose.$cgi_ext") {
		open (FILE, "< $path/diagnose.$cgi_ext");
		my @file = <FILE>;
		close (FILE);
		$pathperl = $file[0];
		$pathperl =~ s/^#!//;
		$pathperl =~ s/\s+$//;
		return $path;
	}
	return "";
}
sub check_html_path {
	my ($path, $full_path) = @_;
	return $full_path if $full_path;
	return $path if -e "$path/messages/board-topics.html";
	return "";
}
sub flush {
	$| = 1; print ""; $| = 0;
}
#-------------------------------------------------------------------------------
#-------------------------------------------------------------------------------
sub prline {
	my ($flag) = @_;
	if ($flag == 1) {
		print " " x (60 - $LASTLEN);
		print "<!--ERROR--><FONT COLOR=#ff0000><B>ERROR!</B></FONT>\n";
		$LASTLEN = 0;
	} elsif ($flag == 2) {
		print " " x (60 - $LASTLEN);
		print "<FONT COLOR=#00aa00><B>PASSED!</B></FONT>\n";
		$LASTLEN = 0;
	} elsif ($flag == 3) {
		print " " x (60 - $LASTLEN);
		print "<FONT COLOR=#aaaa00><B>Not Installed</B></FONT>\n";
		$LASTLEN = 0;
	} elsif ($flag == 4) {
		print " " x (60 - $LASTLEN);
		print "<FONT COLOR=#0000aa><B>Installed</B></FONT>\n";
		$LASTLEN = 0;
	} else {
		print "<B>$flag:</B>";
		$LASTLEN = length($flag);
	}
}
sub dirlist {
	my ($dir) = @_;
	if (opendir(DIR, "$dir")) {
		print "<FONT COLOR=#00aa00>$dir</FONT>\n";
		while ($filename = readdir(DIR)) {
			($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,$atime,$mtime,$ctime,$blksize,$blocks) = stat "$dir/$filename";
			$x = sprintf("%6o", $mode);
			$md = substr($x, 3, 3);
			$ds = substr($x, 0, 2);
			$mode = "d" if $ds == 4;
			$mode = "-" if $ds == 10;
			for ($i = 0; $i <= 2; $i++) {
				$mode .= &perm(substr($md, $i, 1));
			}
			$uid2 = $uid{$uid}; $uid2 = $uid if $uid2 eq "";
			$gid2 = $gid{$gid}; $gid2 = $gid if $gid2 eq "";
			($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime($mtime);
			$mn = ("Jan", "Feb", "Mar", "Apr", "May", "Jun", "Jul", "Aug", "Sep", "Oct", "Nov", "Dec")[$mon];
			$dy = $mday; $hr = $hour; $min = "0$min" if $min < 10;
			$filename .= "/" if $ds == 4;
			write(STDOUT);
		}
		closedir(DIR);
	} else {
		print "  <FONT COLOR=#ff0000>$dir [$!]</FONT>\n";
	}
	print "\n\n";
}
sub perm {
	my ($arg) = @_;
	return "rwx" if $arg == 7;
	return "rw-" if $arg == 6;
	return "r-x" if $arg == 5;
	return "r--" if $arg == 4;
	return "-wx" if $arg == 3;
	return "-w-" if $arg == 2;
	return "--x" if $arg == 1;
	return "---" if $arg == 0;
}
# END - FILE IS CORRECTLY UPLOADED #

