home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ftp.sunet.sepub/pictures
/
2014.11.ftp.sunet.se-pictures.tar
/
ftp.sunet.se
/
pub
/
pictures
/
ACiD-artpacks
/
www
/
mirrors
/
acheron
/
cgi-bin
/
discus
/
diagnose.cgi
< prev
next >
Wrap
Text File
|
1999-01-26
|
8KB
|
243 lines
#!/usr/bin/perl
$discus_conf = '/usr/local/www/www.acheron.org/discus_admin_245059122/discus.conf';
#-------------------------------------------------------------------------------
# This script is copyright (c) 1998 by DiscusWare, LLC, all rights reserved.
# Its use is subject to the license agreement that can be found at the following
# URL: http://www.chem.hope.edu/discus/license
#-------------------------------------------------------------------------------
print "Content-type: text/html\n\n";
print "<HTML><HEAD><TITLE>Discus program diagnostics</TITLE></HEAD>\n";
print "<BODY BGCOLOR=#ffffff TEXT=#000000>\n";
print "<H1>Discus Program Diagnostics</H1>\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.chem.hope.edu/discus/rc\">Discus Resource Center</A>\n";
print "for support and troubleshooting assistance.<P>\n";
print "<HR>\n";
print "<PRE>\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-->\n";
} 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-->\n";
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.chem.hope.edu/~discus/cgi-bin/home2/checker4.cgi?15\">Click here for help</A>\n";
} else {
&prline(2);
print "<!--DCM: OK-->\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 "<!--AD: OK-->\n";
&prline("Checking existence of source directory");
if (-e("$admin_dir/source")) {
&prline(2);
print "<!--SRD: OK-->\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 = <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-->\n";
} else {
print "<!--SRF: OK-->\n";
}
} else {
&prline(1);
print " $admin_dir/source directory doesn't exist! :(\n";
print " <A HREF=\"http://www.chem.hope.edu/~discus/cgi-bin/home2/checker4.cgi?14\">Click here for help</A>\n";
print "<!--SRD: DNE-->\n";
}
} else {
&prline(1);
print " $admin_dir directory doesn't exist!</B>\n";
print "<!--AD: DNE-->\n";
}
&prline("Checking existence of HTML directory");
if (-e($html_dir)) {
&prline(2);
print "<!--HD: OK-->\n";
} else {
&prline(1);
print " <A HREF=\"http://www.chem.hope.edu/~discus/cgi-bin/home2/checker4.cgi?15\">Click here for help</A>\n";
print "<!--HD: DNE-->\n";
}
&prline("Checking existence of script directory");
if (-e($script_dir)) {
&prline(2);
print "<!--SD: OK-->\n";
} else {
&prline(1);
print " <A HREF=\"http://www.chem.hope.edu/~discus/cgi-bin/home2/checker4.cgi?16\">Click here for help</A>\n";
print "<!--SD: DNE-->\n";
}
if ($^O eq "MSWin32") {
print "<!--PLATFORM: WIN-->\n";
} else {
print "<!--PLATFORM: UNIX-->\n";
}
if ($ENV{'REMOTE_ADDR'} eq "198.110.101.15") {
# For the Discus Site Checker, but not for curious visitors!
print "<!--LICENSE: $pro_license-->\n" if $pro;
}
&prline("Checking \"crypt()\" function");
if (eval '$test = crypt("Foo", "Foo");') {
&prline(2);
print "<!--CRYPT: OK-->\n";
} else {
&prline(1);
print "<!--CRYPT: NO-->\n";
print "<B> Warning! This port of Perl does not support 'crypt'!</B>\n";
print " <A HREF=\"http://www.chem.hope.edu/~discus/cgi-bin/home2/checker4.cgi?19\">Click here for help</A>\n";
}
&prline("Checking for Perl 5");
$v = $];
if ($v < 5) {
&prline(1);
print "<!--PERL: $]-->\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 "<!--PERL: $]-->\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 "<!--DC: DNE-->\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 "<!--PLATFORM: WIN-->\n" if (-e "C:/" || $^O eq "MSWin32");
print "<!--PLATFORM: UNIX-->\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 "<!--LICENSE: $pro_license-->\n" if $pro;
}
if (eval '$test = crypt("Foo", "Foo");') {
print "<!--CRYPT: OK-->\n";
} else {
print "<!--CRYPT: NO-->\n";
}
print "<P><HR><P>\n";
print "Discus has prepared some resources to assist you in diagnosing this problem.\n";
print "Please go to the <A HREF=http://www.chem.hope.edu/discus/rc TARGET=_top>Discus";
print " Resource Center</A> for help to diagnose and fix the\nproblem you are ";
print "experiencing!\n";
print "</BODY></HTML>\n";
sub recursion {
}
sub prline {
local ($flag) = @_;
if ($flag == 1) {
print " " x (50 - $LASTLEN);
print "<FONT COLOR=#ff0000><B>ERROR!</B></FONT>\n";
$LASTLEN = 0;
} elsif ($flag == 2) {
print " " x (50 - $LASTLEN);
print "<FONT COLOR=#00aa00><B>PASSED!</B></FONT>\n";
$LASTLEN = 0;
} else {
print "<B>$flag:</B>";
$LASTLEN = length($flag);
}
}