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 / hirez / cgi-bin / discus / diagnose.cgi < prev    next >
Text File  |  1999-02-12  |  8KB  |  243 lines

  1. #!/usr/bin/perl
  2. $discus_conf = '/usr/local/www/www.hirez.org/discus_admin_149349189/discus.conf';
  3. #-------------------------------------------------------------------------------
  4. # This script is copyright (c) 1998 by DiscusWare, LLC, all rights reserved.
  5. # Its use is subject to the license agreement that can be found at the following
  6. # URL:  http://www.chem.hope.edu/discus/license
  7. #-------------------------------------------------------------------------------
  8. print "Content-type: text/html\n\n";
  9. print "<HTML><HEAD><TITLE>Discus program diagnostics</TITLE></HEAD>\n";
  10. print "<BODY BGCOLOR=#ffffff TEXT=#000000>\n";
  11. print "<H1>Discus Program Diagnostics</H1>\n";
  12. print "The following are the results of the Discus Program self-diagnostics.\n";
  13. print "If you do not see any error messages, then the problem you are experiencing\n";
  14. print "is likely not a problem with your setup.  You can always consult the\n";
  15. print "<A HREF=\"http://www.chem.hope.edu/discus/rc\">Discus Resource Center</A>\n";
  16. print "for support and troubleshooting assistance.<P>\n";
  17. print "<HR>\n";
  18. print "<PRE>\n";
  19. &prline("Checking discus.conf existence");
  20. if (-e "$discus_conf") {
  21.     &prline(2);
  22.     &prline("Checking discus.conf readability");
  23.     if (open(DC, "$discus_conf")) {
  24.         &prline(2);
  25.         print "<!--DC: OK-->\n";
  26.     } else {
  27.         &prline(1);
  28.         print "Your discus.conf file is not readable.\n";
  29.         print "Reason: <FONT COLOR=#ff0000>$!</FONT>\n" if $!;
  30.         print "Check that permissions on discus.conf are set properly\n";
  31.         print "to 0755 (rwxr-xr-x).  I think that's your problem!\n";
  32.         print "<!--DC: NR-->\n";
  33.         exit(0);
  34.     }
  35.     @file = <DC>;
  36.     close (DC);
  37.     &prline("Checking discus.conf uploaded in ASCII mode");
  38.     if (grep(/\r/, @file) && $^O ne "MSWin32") {
  39.         &prline(1);
  40.         print "It looks like you uploaded discus.conf in binary or automatic mode.\n";
  41.         print "Try uploading discus.conf in ASCII mode.\n";
  42.         print "<!--DCM: BINARY-->\n";
  43.         print "  <A HREF=\"http://www.chem.hope.edu/~discus/cgi-bin/home2/checker4.cgi?15\">Click here for help</A>\n";
  44.     } else {
  45.         &prline(2);
  46.         print "<!--DCM: OK-->\n";
  47.     }
  48.     $evals = "";
  49.     foreach $line (@file) {
  50.         if ($line =~ /^(\w+)=(.*)/) {
  51.             $varname = $1;
  52.             $value = $2;
  53.             $value =~ s/'/\\'/g; $value =~ s/\r//g;
  54.             $evals .= "\$$varname='$value'; ";
  55.         }
  56.     }
  57.     eval($evals);
  58.     &prline("Checking existence of administration directory");
  59.     if (-e($admin_dir)) {
  60.         &prline(2);
  61.         print "<!--AD: OK-->\n";
  62.         &prline("Checking existence of source directory");
  63.         if (-e("$admin_dir/source")) {
  64.             &prline(2);
  65.             print "<!--SRD: OK-->\n";
  66.             undef @needed_src;
  67.             for ($i = 1; $i <= 10; $i++) {
  68.                 push (@needed_src, "src-board-subs-$i");
  69.             }
  70.             push (@needed_src, "src-board-subs-common");
  71.             push (@needed_src, "src-board-subs-admin");
  72.             if ($pro) {
  73.                 for ($i = 100; $i <= 106; $i++) {
  74.                     push (@needed_src, "src-board-subs-$i");
  75.                 }
  76.             }
  77.             $errors = 0;
  78.             foreach $file (@needed_src) {
  79.                 &prline("Checking source file $file");
  80.                 if ($file =~ m|src-board-subs-10(\d)|) {
  81.                     $dir = join("_", $file, $pro_fileid);
  82.                 } else {
  83.                     $dir = $file;
  84.                 }                
  85.                 if (open(SRC, "$admin_dir/source/$dir")) {
  86.                     @src = <SRC>;
  87.                     close (SRC);
  88.                     if (grep(/\r/, @src) && $^O ne "MSWin32") {
  89.                         &prline(1); $errors += 1;
  90.                         print "  $admin_dir/source/$file was not uploaded in ASCII mode\n";
  91.                     } else {
  92.                         &prline(2);
  93.                     }
  94.                 } else {
  95.                     &prline(1); $errors += 1;
  96.                     print "  $admin_dir/source/$file is not readable\n";
  97.                     print "  <FONT COLOR=#ff0000>$!</FONT>\n" if $!;
  98.                 }
  99.             }
  100.             if ($errors) {
  101.                 print "<!--SRF: DNE-->\n";
  102.             } else {
  103.                 print "<!--SRF: OK-->\n";
  104.             }
  105.         } else {
  106.             &prline(1);
  107.             print "  $admin_dir/source directory doesn't exist! :(\n";
  108.             print "  <A HREF=\"http://www.chem.hope.edu/~discus/cgi-bin/home2/checker4.cgi?14\">Click here for help</A>\n";
  109.             print "<!--SRD: DNE-->\n";
  110.         }
  111.     } else {
  112.         &prline(1);
  113.         print "  $admin_dir directory doesn't exist!</B>\n";
  114.         print "<!--AD: DNE-->\n";
  115.     }
  116.     &prline("Checking existence of HTML directory");
  117.     if (-e($html_dir)) {
  118.         &prline(2);
  119.         print "<!--HD: OK-->\n";
  120.     } else {
  121.         &prline(1);
  122.         print "  <A HREF=\"http://www.chem.hope.edu/~discus/cgi-bin/home2/checker4.cgi?15\">Click here for help</A>\n";
  123.         print "<!--HD: DNE-->\n";
  124.     }
  125.     &prline("Checking existence of script directory");
  126.     if (-e($script_dir)) {
  127.         &prline(2);
  128.         print "<!--SD: OK-->\n";
  129.     } else {
  130.         &prline(1);
  131.         print "  <A HREF=\"http://www.chem.hope.edu/~discus/cgi-bin/home2/checker4.cgi?16\">Click here for help</A>\n";
  132.         print "<!--SD: DNE-->\n";
  133.     }
  134.     if ($^O eq "MSWin32") {
  135.         print "<!--PLATFORM: WIN-->\n";
  136.     } else {
  137.         print "<!--PLATFORM: UNIX-->\n";
  138.     }
  139.     if ($ENV{'REMOTE_ADDR'} eq "198.110.101.15") {
  140.         # For the Discus Site Checker, but not for curious visitors!
  141.         print "<!--LICENSE: $pro_license-->\n" if $pro;
  142.     }
  143.     &prline("Checking \"crypt()\" function");
  144.     if (eval '$test = crypt("Foo", "Foo");') {
  145.         &prline(2);
  146.         print "<!--CRYPT: OK-->\n";
  147.     } else {
  148.         &prline(1);
  149.         print "<!--CRYPT: NO-->\n";
  150.         print "<B>  Warning!  This port of Perl does not support 'crypt'!</B>\n";
  151.         print "  <A HREF=\"http://www.chem.hope.edu/~discus/cgi-bin/home2/checker4.cgi?19\">Click here for help</A>\n";
  152.     }
  153.     &prline("Checking for Perl 5");
  154.     $v = $];
  155.     if ($v < 5) {
  156.         &prline(1);
  157.         print "<!--PERL: $]-->\n";
  158.         print "  Some features of Discus and Discus Pro require that you have Perl 5\n";
  159.         print "  installed.  We have programmed Discus to be as backward compatible\n";
  160.         print "  with Perl 4 as possible, but Perl 4 is buggy and isn't supported\n";
  161.         print "  any more (it's several years old!).  If possible, you should have\n";
  162.         print "  selected Perl 5 to use for the installation of Discus.  Your Perl\n";
  163.         print "  version is $v, by the way.\n";
  164.     } else {
  165.         &prline(2);
  166.         print "<!--PERL: $]-->\n";
  167.     }    
  168.     print "End diagnostics.\n\n";
  169.     exit(0);
  170. }
  171. # OOPS, DISCUS.CONF IS WRONG!
  172. # Let's see if we can find it.
  173. &prline(1);
  174. if ($^O ne "MSWin32") {
  175.     $pwd = `pwd`;
  176.     chop ($pwd) if $pwd =~ m|\n$|;
  177.     eval '$home = (getpwuid($<))[7];';
  178. }
  179. $docroot = $ENV{'DOCUMENT_ROOT'};
  180. $filename = $ENV{'SCRIPT_FILENAME'};
  181. $path = $ENV{'PATH_TRANSLATED'};
  182. if (!eval 'use Cwd;') {
  183.     eval '$cwd = cwd();';
  184. } else {
  185.     $cwd = "";
  186. }
  187. print "<!--DC: DNE-->\n\n";
  188. print "You have the directory paths wrong, or the program can't read\n";
  189. print "the directories you specified (probably the former).  Here are\n";
  190. print "some helpful indicators of what directories should be:\n\n";
  191. print "Working directory:    $pwd\n";
  192. print "Your home directory:  $home\n";
  193. print "Document root:        $docroot\n";
  194. print "Script filename:      $filename\n";
  195. print "Translated Path:      $path\n";
  196. print "Current Directory:    $cwd\n";
  197. print "\nIMPORTANT:  Some of these will not work, depending on your system.\n";
  198. print "Do not be distrurbed if some of these do not show up!\n\n";
  199. print "\n", "-" x 50, "\n";
  200. print "ENVIRONMENT VARIABLES:\n\n";
  201. format STDOUT =
  202. ENV @<<<<<<<<<<<<<<<<<<<   @<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
  203. $var, $val
  204. .
  205. foreach $key (sort(keys(%ENV))) {
  206.     $var = $key; $val = $ENV{$key};
  207.     write (STDOUT);
  208. }
  209. print "<!--PLATFORM: WIN-->\n" if (-e "C:/" || $^O eq "MSWin32");
  210. print "<!--PLATFORM: UNIX-->\n" if -e "/etc/passwd";
  211. if ($ENV{'REMOTE_ADDR'} eq "198.110.101.15") {
  212.     # For the Discus Site Checker, but not for curious visitors!
  213.     print "<!--LICENSE: $pro_license-->\n" if $pro;
  214. }
  215. if (eval '$test = crypt("Foo", "Foo");') {
  216.     print "<!--CRYPT: OK-->\n";
  217. } else {
  218.     print "<!--CRYPT: NO-->\n";
  219. }
  220. print "<P><HR><P>\n";
  221. print "Discus has prepared some resources to assist you in diagnosing this problem.\n";
  222. print "Please go to the <A HREF=http://www.chem.hope.edu/discus/rc TARGET=_top>Discus";
  223. print " Resource Center</A> for help to diagnose and fix the\nproblem you are ";
  224. print "experiencing!\n";
  225. print "</BODY></HTML>\n";
  226. sub recursion {
  227. }
  228. sub prline {
  229.     local ($flag) = @_;
  230.     if ($flag == 1) {
  231.         print " " x (50 - $LASTLEN);
  232.         print "<FONT COLOR=#ff0000><B>ERROR!</B></FONT>\n";
  233.         $LASTLEN = 0;
  234.     } elsif ($flag == 2) {
  235.         print " " x (50 - $LASTLEN);
  236.         print "<FONT COLOR=#00aa00><B>PASSED!</B></FONT>\n";
  237.         $LASTLEN = 0;
  238.     } else {
  239.         print "<B>$flag:</B>";
  240.         $LASTLEN = length($flag);
  241.     }
  242. }
  243.