#!/usr/bin/perl
# DISCUS 2.50/3.00 INTERACTIVE SETUP
# CONGRATULATIONS! THIS STEP WORKED PROPERLY!
#
# Now, select "File | Save As..." from your browser's window.
# This output should be saved as "ftpdiag.cgi" in any temporary
# folder on your hard disk. When you have saved the file, use your
# browser's back button to return to the instructions.
#
# This script is Copyright (c) 1998 by Kevin W. Paulisse and William
# F. Polik. It is governed by the General Use license of the Discus
# discussion board program. http://www.chem.hope.edu/discus
#
#
#
#
#
$| = 1;
print "Content-type: text/html\n\n";
eval '$home = (getpwuid($<))[7];';
if (!-e "C:/") {
$pwd = `pwd`; chop $pwd;
}
if (!eval 'use Cwd;') {
eval '$cwd = cwd();';
} else {
$cwd = "";
}
$prog = $0;
$prog =~ m|ftpdiag\.(\w+)|; $prog = "ftpdiag.$1";
$cgi_extension = $1;
$b4 = $`; $b4 =~ s/\/$//; $b4 =~ s/\\$//;
$docroot = $ENV{'DOCUMENT_ROOT'};
$docroot =~ s/\/$//;
$docroot =~ s/\\$//;
$filename = $ENV{'SCRIPT_FILENAME'};
$filename =~ s/\/$prog//;
$filename =~ s/\\$prog//;
$path = $ENV{'PATH_TRANSLATED'};
$path =~ s/\/$//;
$path =~ s/\\$//;
&check($pwd);
&check($b4);
&check($home);
&check($docroot);
&check($filename);
&check($path);
&check($cwd);
if ($real eq "") {
$real = &determine_cwd;
}
if ($real eq "") {
print "Sorry...\n";
print "
Setup Complication\n\n";
print "The setup script could not determine the current working directory\n";
print "of the server. This is very rare (only 1-2% of servers). The environment\n";
print "variables and other potentially helpful values are being printed here for\n";
print "your reference:\n\n";
print "PWD $pwd\n";
print "Server home $home\n";
print "Doc. Root $docroot\n";
print "File name $filename\n";
print "Path $path\n";
print "CWD $cwd\n\n";
print "Here are the environment variables:\n\n";
foreach $key (sort keys(%ENV)) {
print "$key = [$ENV{$key}]\n";
}
print "\n\n";
print "Due to this failure, you should probably use the above information\n";
print "to use the Discus FTP detailed instructions.\n";
print "
\n";
exit(0);
}
opendir(CURDIR, "..");
while ($q = readdir(CURDIR)) {
push (@founddir, $q);
}
closedir(CURDIR);
open (PROG, $prog);
@prog = ;
close (PROG);
$perl = $prog[0];
$perl =~ s/^#!//;
$real =~ s%\\%/%g;
$real =~ s%//%/%g;
if ($real =~ m|(.*)/(.+)|) {
$base = $1; $cgi = $2;
} else {
$base = $real; $cgi = "cgi-bin";
}
$admin_dir = "$base/discus_admin_";
$p = $$; $p =~ s/\D//g;
$p .= substr(time, 0, -5);
$admin_dir .= $p;
$poss_html_dir = "public_html htdocs htdoc html www doc docs wwwdoc wwwdocs wwwroot httpd";
@poss = split(/\s/, $poss_html_dir);
@founddir = grep(!/\./, @founddir);
foreach $dir (@poss) {
if (grep(/^$dir$/, @founddir)) {
$html_dir = "$base/$dir/discus";
last;
}
}
if ($html_dir eq "") {
$html_dir = "$base/discus";
}
$script_dir = "$real/discus";
$sn = "";
if ($ENV{'SCRIPT_URI'} ne "") {
$sn = $ENV{'SCRIPT_URI'};
} elsif ($ENV{'SCRIPT_URL'} ne "") {
$sn = $ENV{'SCRIPT_URL'};
} elsif ($ENV{'REQUEST_URI'}) {
$sn = $ENV{'REQUEST_URI'};
} elsif ($ENV{'SCRIPT_NAME'} ne "") {
$sn = $ENV{'SCRIPT_NAME'};
}
if ($sn ne "") {
if ($sn =~ m|^http://([^/]+)|) {
$sn = $';
}
if ($sn =~ m|/$prog|) {
$sn = $`;
}
if ($sn ne "") {
$script_url = "http://$ENV{'HTTP_HOST'}$sn/discus";
}
} else {
$script_url = "http://$ENV{'HTTP_HOST'}/$cgi/disdcus";
}
if ($script_url =~ m|^http://([^/]+)/~([^/]+)/|) {
$uinfo = "~" . $2 . "/";
}
$html_url = "http://$ENV{'HTTP_HOST'}/$uinfo" . "discus";
# For NT users, convert / to \ to make it look more familiar
$admin_dir =~ s%/%\\%g if $admin_dir =~ m|^(\w+):|;
$html_dir =~ s%/%\\%g if $html_dir =~ m|^(\w+):|;
$script_dir =~ s%/%\\%g if $script_dir =~ m|^(\w+):|;
$bdcgi = "$base/$cgi";
$bdcgi =~ s%/%\\%g if $admin_dir =~ m|^(\w+):|;
$admin_dir =~ s%\\\\%\\%g;
$html_dir =~ s%\\\\%\\%g;
$script_dir =~ s%\\\\%\\%g;
$bdcgi =~ s%\\\\%\\%g;
if (-e "C:/" || $^O eq "MSWin32") {
$NTFLAG = '';
}
if ($] < 5) {
$perl4warn = "Perl Version Warning: The Perl path that\n";
$perl4warn .= "you selected, $perl, is running Perl version $].\n";
$perl4warn .= "Version 3.0 and 3.0 pro of Discus require Perl 5. In most cases,\n";
$perl4warn .= "there will not be any difficulties, but it is strongly\n";
$perl4warn .= "recommended that you consult your ISP's documents and determine\n";
$perl4warn .= "if you can select a different Perl path for Perl version 5.\n";
}
print <<_END_;
Discus Setup - Interactive Form