\n"; print "
\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 "\n";
} else {
&prline(1);
print "Your discus.conf file is not readable.\n";
print "Reason: $!\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 "\n";
exit(0);
}
@file = ;
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 "\n";
print " Click here for help\n";
} else {
&prline(2);
print "\n";
}
$evals = "";
foreach $line (@file) {
if ($line =~ /^(\w+)=(.*)/) {
$varname = $1;
$value = $2;
$value =~ s/'/\\'/g; $value =~ s/\r//g;
$evals .= "\$$varname='$value'; ";
}
}
eval($evals);
&prline("Checking existence of administration directory");
if (-e($admin_dir)) {
&prline(2);
print "\n";
&prline("Checking existence of source directory");
if (-e("$admin_dir/source")) {
&prline(2);
print "\n";
undef @needed_src;
for ($i = 1; $i <= 10; $i++) {
push (@needed_src, "src-board-subs-$i");
}
push (@needed_src, "src-board-subs-common");
push (@needed_src, "src-board-subs-admin");
if ($pro) {
for ($i = 100; $i <= 106; $i++) {
push (@needed_src, "src-board-subs-$i");
}
}
$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 = ;
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 " $!\n" if $!;
}
}
if ($errors) {
print "\n";
} else {
print "\n";
}
} else {
&prline(1);
print " $admin_dir/source directory doesn't exist! :(\n";
print " Click here for help\n";
print "\n";
}
} else {
&prline(1);
print " $admin_dir directory doesn't exist!\n";
print "\n";
}
&prline("Checking existence of HTML directory");
if (-e($html_dir)) {
&prline(2);
print "\n";
} else {
&prline(1);
print " Click here for help\n";
print "\n";
}
&prline("Checking existence of script directory");
if (-e($script_dir)) {
&prline(2);
print "\n";
} else {
&prline(1);
print " Click here for help\n";
print "\n";
}
if ($^O eq "MSWin32") {
print "\n";
} else {
print "\n";
}
if ($ENV{'REMOTE_ADDR'} eq "198.110.101.15") {
# For the Discus Site Checker, but not for curious visitors!
print "\n" if $pro;
}
&prline("Checking \"crypt()\" function");
if (eval '$test = crypt("Foo", "Foo");') {
&prline(2);
print "\n";
} else {
&prline(1);
print "\n";
print " Warning! This port of Perl does not support 'crypt'!\n";
print " Click here for help\n";
}
&prline("Checking for Perl 5");
$v = $];
if ($v < 5) {
&prline(1);
print "\n";
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 {
&prline(2);
print "\n";
}
print "End diagnostics.\n\n";
exit(0);
}
# OOPS, DISCUS.CONF IS WRONG!
# Let's see if we can find it.
&prline(1);
if ($^O ne "MSWin32") {
$pwd = `pwd`;
chop ($pwd) if $pwd =~ m|\n$|;
eval '$home = (getpwuid($<))[7];';
}
$docroot = $ENV{'DOCUMENT_ROOT'};
$filename = $ENV{'SCRIPT_FILENAME'};
$path = $ENV{'PATH_TRANSLATED'};
if (!eval 'use Cwd;') {
eval '$cwd = cwd();';
} else {
$cwd = "";
}
print "\n\n";
print "You have the directory paths wrong, or the program can't read\n";
print "the directories you specified (probably the former). Here are\n";
print "some helpful indicators of what directories should be:\n\n";
print "Working directory: $pwd\n";
print "Your home directory: $home\n";
print "Document root: $docroot\n";
print "Script filename: $filename\n";
print "Translated Path: $path\n";
print "Current Directory: $cwd\n";
print "\nIMPORTANT: Some of these will not work, depending on your system.\n";
print "Do not be distrurbed if some of these do not show up!\n\n";
print "\n", "-" x 50, "\n";
print "ENVIRONMENT VARIABLES:\n\n";
format STDOUT =
ENV @<<<<<<<<<<<<<<<<<<< @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
$var, $val
.
foreach $key (sort(keys(%ENV))) {
$var = $key; $val = $ENV{$key};
write (STDOUT);
}
print "\n" if (-e "C:/" || $^O eq "MSWin32");
print "\n" if -e "/etc/passwd";
if ($ENV{'REMOTE_ADDR'} eq "198.110.101.15") {
# For the Discus Site Checker, but not for curious visitors!
print "\n" if $pro;
}
if (eval '$test = crypt("Foo", "Foo");') {
print "\n";
} else {
print "\n";
}
print "
\n";
print "Discus has prepared some resources to assist you in diagnosing this problem.\n";
print "Please go to the Discus";
print " Resource Center for help to diagnose and fix the\nproblem you are ";
print "experiencing!\n";
print "\n";
sub recursion {
}
sub prline {
local ($flag) = @_;
if ($flag == 1) {
print " " x (50 - $LASTLEN);
print "ERROR!\n";
$LASTLEN = 0;
} elsif ($flag == 2) {
print " " x (50 - $LASTLEN);
print "PASSED!\n";
$LASTLEN = 0;
} else {
print "$flag:";
$LASTLEN = length($flag);
}
}