#!/usr/ucb/perl
# Generated board setup script

##################################################
# VARIABLES FROM THE FIRST SETUP SCRIPT

$chosen_perl = '/usr/ucb/perl';
$install_dir = '/u1/faculty/tis/discus3_10';
$cgi_extension = 'cgi';
$chosen_dir = '/u1/faculty/tis/public_html';
$uid = 'tis';
$hostname = 'artemis.simmons.edu';
$your_name = 'Bruce Tis';
$home = '/u1/faculty/tis';
$www_subdir = 'public_html';
$unix = '1';
$windows = '';
$win95 = '';
$nt = '';
$DISCUS_VERSION = '3.10';
$pro_license = '';

##################################################
# SCRIPT READ IN FROM src-board-setup


########################################################
# File: src-board-setup
# Copyright (c) 1998-2000 by DiscusWare, LLC, all rights
# reserved
#
# This is the source for the Discus WWW setup script...
# Version 3.10
########################################################

$this_version_of_Discus_is="3.10";

########################################################
# If your server runs in a 'chroot'-ed environment, and
# it cannot find the "install.pl" script, you can define
# the following variable to be the DIRECTORY in which
# the install.pl script exists according to what your
# server sees.

$OVERRIDE_DIR = "";

########################################################

$OVERRIDE_DIR =~ s/\/$//;
&parse_form;

# Trim leading, trailing spaces

foreach $key (keys(%FORM)) {
	$value = $FORM{$key};
	$value =~ s/^(\s+)//g;
	$value =~ s/(\s+)$//g;
	$value =~ s/'/\\'/g;
	$FORM{$key} = $value;
}

# This occurs when the user accesses the setup form for the first
# time.  Perform some checking for directory consistency and so on
# and then print out the form.

if (-e "$install_dir/install.pl") {
	$chosen_dir = $install_dir;
	$ch_d = $install_dir;
	open (INSTALL, ">$chosen_dir/install.pl");
	print INSTALL "#!", $chosen_perl, "\n";
	print INSTALL "#Generated installation file, successfully reset\n";
	print INSTALL "#by the setup script.\n";
	print INSTALL "#THIS IS A GENERATED FILE! DO NOT EDIT!\n\n";
	close (INSTALL);
} else {
	undef @cwd;
	if ($unix) {
		$pwd = `pwd`;
		chop ($pwd) if $pwd =~ m|\n$|;
		push (@cwd, $pwd) if $pwd ne "";
	}
	push (@cwd, $ENV{'PWD'}) if $ENV{'PWD'} ne "";
	if ($ENV{'SCRIPT_FILENAME'}) {
		$ENV{'SCRIPT_FILENAME'} =~ m|^(\S+)/board-setup\.$cgi_extension|;
		push (@cwd, $1);
	}
	if ($ENV{'PATH_TRANSLATED'}) {
		push (@cwd, $ENV{'PATH_TRANSLATED'});
	}
	if (!eval 'use Cwd;') {
		eval '$cwd = cwd();';
		push (@cwd, $cwd);
	}
	$p_dir = "";
	foreach $dir (@cwd) {
		if (-d $dir && -e "$dir/board-setup.$cgi_extension") {
			$p_dir = $dir;
			last;
		}
	}
	$ch_d = "$OVERRIDE_DIR/install.pl" if $OVERRIDE_DIR;
	if ($ch_d eq "") {
		@dir_frag = split(/\//, $install_dir);
		shift @dir_frag;
		$ch_d = "";
		$prepend = "/";
		while ($_ = shift(@dir_frag)) {
			$prepend .= "$_";
			$new_dir = join("/", @dir_frag);
			if (-e "/$new_dir/install.pl") {
				$ch_d = "/$new_dir";
				last;
			}
			$prepend .= "/";
		}
	}
	if ($ch_d eq "") {
		$prepend = "";
		&give_up if $p_dir eq "";
		$svr_prepend = "";
		@dir_frag = split(/\//, $p_dir);
		shift @dir_frag;
		while ($_ = shift(@dir_frag)) {
			$svr_prepend .= "/$_";
			if (-e "$svr_prepend/$install_dir/install.pl") {
				$ch_d = "$svr_prepend/$install_dir";
				last;
			}
		}
		&give_up if $ch_d eq "";
	}
}

if ($FORM{'action'} eq "") {
	if ($unix) {
		$doc_root = $ENV{'DOCUMENT_ROOT'};
		$script_root = "";
		$doc_root =~ s/\/$//;
		$doc_root =~ m|(.*)/|;
		$doc_root_before = $1;
		$tries = "scripts cgi-bin cgi-local webscripts cgi-src script cgilocal cgibin $ENV{'SCRIPT_PATH'} $ENV{'CGI_ROOT'}";
		@tries = split(/\s+/, $tries);
		foreach $try (@tries) {
			if (-d "$doc_root_before/$try") {
				$script_root = "$doc_root_before/$try";
				$script_root_short = "$try";
				last;
			}
			if (-d "$doc_root/$try") {
				$script_root = "$doc_root/$try";
				$script_root_short = "$try";
				last;
			}
		}
		if ($script_root eq "") {
			$script_root = "$ENV{'DOCUMENT_ROOT'}/cgi-bin";
			$script_root_short = "cgi-bin";
		}
	} else {
		$doc_root = $ENV{'DOCUMENT_ROOT'};
		if ($doc_root !~ /^\w:(\/|\\)/) {
			$doc_root = 'C:\InetPub\WWWRoot';
		}
		$doc_root =~ s/\//\\/g;
		$script_root = "";
		$doc_root =~ s/\\$//;
		$doc_root =~ s/\/$//;
		$doc_root =~ m|(.*)\\|;
		$doc_root_before = $1;
		$tries = "scripts cgi-bin cgi-local webscripts cgi-src script cgilocal cgibin $ENV{'SCRIPT_PATH'} $ENV{'CGI_ROOT'}";
		@tries = split(/\s+/, $tries);
		foreach $try (@tries) {
			if (-d "$doc_root_before\\$try") {
				$script_root = "$doc_root_before\\$try";
				$script_root_url = "$ENV{'HTTP_HOST'}/$try";
				last;
			}
			if (-d "$doc_root\\$try") {
				$script_root = "$doc_root\\$try";
				$script_root_url = "$ENV{'HTTP_HOST'}/$try";
				last;
			}
		}
		if ($script_root eq "") {
			$script_root = "C:\\InetPub\\Scripts";
			$script_root_url = "$ENV{'HTTP_HOST'}/Scripts";
		}
	}
	&display_form;
	exit(0);
}

# Receive User Input, write to "install.pl"

$ch_d =~ s/\\/\//g;
$ch_d =~ s/\/$//;
$install_dir =~ s/\\/\//g;
$install_dir =~ s/\/$//;

$install_pl = "$ch_d/install.pl";
$cleanup_pl = "$ch_d/cleanup.pl";
$uninstall_pl = "$ch_d/uninstall.pl";

open (FILE, ">$install_pl");
print FILE "#!$chosen_perl\n";
print FILE "#This is a generated file. Do not edit.\n\n";
print FILE "\$language_chosen = '$language_chosen';\n" if $language_chosen;
close (FILE);
open (FILE, ">$cleanup_pl");
print FILE "#!$chosen_perl\n";
print FILE "#This is a generated file. Do not edit.\n\n";
close (FILE);
open (FILE, ">$uninstall_pl");
print FILE "#!$chosen_perl\n";
print FILE "#This is a generated file. Do not edit.\n\n";
close (FILE);

########################################################
#          MAKE SURE DIRECTORY NAMES ARE OK            #
########################################################

@dirs = ("admin_dir", "html_dir", "script_dir");

foreach $dir_key (@dirs) {
	$dir = $FORM{$dir_key};
	$dir =~ s/\\/\//g;
	$dir =~ s/^\s+//g;
	$dir =~ s/\s+$//g;
	$dir =~ s/\/+$//g;
	if ($dir =~ m|^https?://|i) {
		&error_message("'$dir' appears to be a URL and not a directory name (in the specification of <I>$dir_key</I>.)");
	}
	$dir =~ s/\/+/\//g;
	$FORM{$dir_key} = $dir;
	if ($dir ne "/") {
		$dir =~ m|(.*)/(.*)|;
		$parent = $1; $newname = $2;
		if ($parent !~ /^\w:$/) {
			if (!-e "$parent") {
				&error_message("'$parent' does not exist as a directory (in the specification of <I>$dir_key</I>).  This means you need to log in manually and create the directory '$parent'.  Then submit this form again.");
			}
		} else {
			if (!-e "$parent/" && !-e "$parent") {
				&error_message("'$parent/' does not exist as a directory (in the specification of <I>$dir_key</I>).  This means you need to log in manually and create the directory '$parent/'.  Then submit this form again.");
			}
		}
		if ($newname =~ /[^\w\-\+ \.]/) {
			&error_message("'$newname' is not valid as a directory (in the specification of <I>$dir_key</I>).");
		}
	}
}

########################################################
#                     CHECK URLS                       #
########################################################

@urls = ("html_url", "script_url");

foreach $url_key (@urls) {
	$url = $FORM{$url_key};
	$url =~ s/\\/\//g;
	$url =~ s/^\s+//g;
	$url =~ s/\s+$//g;
	$url =~ s/\/+$//g;
	if ($url !~ m|^https?://|i) {
		&error_message("'$url' does not start with <B>http://</B> in specification of $url_key.");
	}
}

########################################################
#                CUSTOMIZED SETTINGS                   #
########################################################

$title = $FORM{'title'};
$title =~ s/!//g;
$title =~ s/\//\\\//g;
if ($title eq "") {
	$title = "Discus";
}
$title_stripped = $title;
$title_stripped =~ s/<([^>]*)>//g;

open (FILE, ">>$install_pl");
print FILE "print \"Beginning installation process!  Please wait...\\n\\n\";\n";
close (FILE);

########################################################
#          CREATE THE FILES FOR THE BOARD!             #
########################################################

$admin_dir_ = $FORM{'admin_dir'};
$html_dir_ = $FORM{'html_dir'};
$script_dir_ = $FORM{'script_dir'};

if ($prepend) {
	$admin_dir_ = "$prepend$FORM{'admin_dir'}";
	$html_dir_ = "$prepend$FORM{'html_dir'}";
	$script_dir_ = "$prepend$FORM{'script_dir'}";
}

$cemail = $FORM{'contact_email'};
$cemail =~ s/@/\\@/g;
$contact = "<A HREF=\\\"mailto:$cemail\\\">$FORM{'contact_name'}</A>";

&copy_files_code;

########################################################
#                        YAY!!!                        #
########################################################

open (FILE, ">>$install_pl");
print FILE <<EOF;

print "\\n" x 20;
print "-" x 50, "\\n";
print "DISCUS SETUP SUCCEEDED!\\n\\n";
print "The installation of Discus has been completed successfully!\\n";
print "It is now time to access your board by entering this URL in your browser:\\n";
print "  $FORM{'html_url'}/\\n\\n";
print "When you do, click on 'Administration'.  Enter 'admin' as the username\\n";
print "and leave the password blank.  Click on 'Log In'.  You will be prompted\\n";
print "to set your password and register Discus.\\n\\n";
print "PRESS ENTER TO EXIT THE SETUP SCRIPT\\n";
\$foo = <STDIN>;
print "\\n\\n";
exit(0);

EOF
close (FILE);
$platform = " for Windows NT" if $nt == 1;
$platform = " for Windows 95" if $win95 == 1;
$platform = " for Unix" if $unix == 1;
$windows_click = " or double click the script from Windows Explorer" if $platform =~ /Windows/;
print "Content-type: text/html\n\n";
print <<_End_Of_YAY_;

<HTML>
<HEAD>
<TITLE>Discus WWW Setup Form - SUCCESS!</TITLE>
</HEAD>
<BODY BGCOLOR=#ffffff TEXT=#000000 LINK=#0000ff VLINK=#0000ff ALINK=#ff0000>
<FONT FACE="Verdana,Arial,Helvetica" SIZE=2>
<TABLE WIDTH=85%><TR><TD>
<TABLE WIDTH=100% BGCOLOR=#0000aa>
<TR><TD ALIGN=CENTER><FONT FACE="Bookman Old Style,Times New Roman" SIZE=6 COLOR=#ffffff><B><I>Discus</I> Setup$platform</B></FONT></TD></TR></TABLE>
</CENTER>
<P>
<H3>Success!</H3>
<P>
Discus Setup$platform has successfully created a Perl script to finish the
installation.  All you need to do is to run the Perl script from the command
line$windows_click, and <B>$FORM{'title'}</B> will be up and running.
<P>
Specifically, here is the procedure:
<P>
_End_Of_YAY_

if ($unix) {
	print "<TABLE BGCOLOR=#ffffcc><TR><TD><PRE>cd $ch_d\nperl install.pl</PRE></TD></TR></TABLE><P>\n";
} else {
	print "Start a MS-DOS prompt and enter these commands:<P>\n";
	$ch_d_2 = $ch_d; $ch_d =~ s/\//\\/g;
	$drive = substr($ch_d_2,0,2);
	print "<TABLE BGCOLOR=#ffffcc><TR><TD><PRE>$drive\ncd $ch_d_2\nperl install.pl</PRE></TD></TR></TABLE><P>\n";
	print "<P>Alternatively, you may use Windows Explorer to navigate to the $ch_d_2 directory and double-click on the \"install.pl\" script.\n";
}

print <<_End_Of_YAY_2_;
<P>
<FONT COLOR=red SIZE=4>AFTER YOU HAVE RUN install.pl</FONT>, you may go to <A HREF="$FORM{'html_url'}/">$FORM{'title'}</A>.
</TD></TR></TABLE>
</BODY>
</HTML>
_End_Of_YAY_2_

exit(0);

########################################################
# COPY FILES

sub copy_files_code {
	open (FILE, ">>$install_pl");
	print FILE "\n# Read in files from file listing and create\n\n";
	print FILE "\$file_list = '$install_dir/source/filelist.txt';\n";
	print FILE 'if (open(LIST, "$file_list")) {', "\n";
	print FILE '  close (LIST);', "\n";
	print FILE '} else {', "\n";
	print FILE '  print "ERROR: Could not open file list ($file_list)!\n";', "\n";
	print FILE '  print "Reason: $!\n";', "\n";
	print FILE '  print "Check permissions and try again.\n\n";', "\n";
	print FILE '  exit(0);', "\n";
	print FILE '}', "\n\n";
	print FILE "# Define subroutines used for copying files\n\n";
	print FILE <<_End_Of_Subroutines;
sub process_file {
	local (\$source, \$destfile, \$perm, \$param) = \@_;
	if (\$param =~ m|\\%| && \$pro_version == 0) {
		return 0;
	}
	\$binmode = 0; \$html = 0; \$cgi = 0; \$force = 0; \$doflag = 0;
	\$binmode = 1 if \$param =~ m|B|;
	\$html = 1 if \$param =~ m|H|;
	\$cgi = 1 if \$param =~ m|C|;
	if (\$param =~ m|c|) {
		\$source .= "-frames" if \$VAR{'interface'} ne "noframes";
		\$source .= "-noframes" if \$VAR{'interface'} eq "noframes";
	}
	\$doflag = 1;	
	\$destfile .= "_\$pro_fileid" if \$param =~ m|h|;
	\$source = "" if \$param =~ m|X|;
	\$source_c = "";
	\$source_c = "Order deny,allow\\nDeny from all\\nAllow from none\\n" if \$param =~ m|~|;
	\$source_c = "<FILES *>\\nRestrictAccess type=deny ip=*\\n</FILES>\\n" if \$param =~ m|\\`|;
	\$source = "**" if \$param =~ m|~|;
	\$source = "**" if \$param =~ m|\\`|;
	if (\$param =~ m|i|) {
		\$source = "src-board" if \$VAR{'interface'} ne "noframes";
		\$source = "src-board-refresh" if \$VAR{'interface'} eq "noframes";
	}
	if (\$param =~ m|\\*|) {
		if (-e \$destfile) {
			chmod (oct(\$perm), \$destfile);
			return 0 if -e \$destfile;
		}
		\$source = "**" if !-e "$install_dir/source/\$source";
	}
	if (\$doflag) {	
		&file_copy(\$source, \$destfile, \$binmode, \$cgi, \$html, \$perm, \$source_c);
	}
	return 1 if \$param =~ m|h|;
}	
	
sub file_copy {
	local (\$sourcefile, \$destfile, \$binary, \$script_flag, \$html_flag, \$permissions, \$source_c) = \@_;
	if (\$sourcefile eq "**") {
		\$sourcefile = "";
		\$source_cd = \$source_c;
		\$source_cd = "\\n" if \$source_c eq "";
	} else {
		\$source_cd = "";
	}
	\$srcfile = "$install_dir/source/languages/\$language_chosen/\$sourcefile" if -e "$install_dir/source/languages/\$language_chosen/\$sourcefile";
	\$srcfile = "$install_dir/source/\$sourcefile" if !-e "$install_dir/source/languages/\$language_chosen/\$sourcefile";
	if (-e "\$srcfile" || \$sourcefile eq "") {
		undef \@source;
		if (open(SOURCE, "\$srcfile")) {		
			eval 'binmode(SOURCE);' if \$binary;
			\@source = <SOURCE>;
			close (SOURCE);
		}
		if (\$source_cd ne "") {
			\@source = split(/\\n/, \$source_cd);
			foreach \$line (\@source) {
				\$line .= "\\n";
			}
		}
		if (open (DEST, ">\$destfile")) {
			eval 'binmode(DEST);' if \$binary;
			if (\$script_flag) {
				print DEST "#!\$chosen_perl\\n";
				print DEST "\\\$discus_conf = '\$VAR{\\"admin_dir\\"}/discus.conf';\\n";
				print DEST "\\\$pro_fileid = '\$pro_fileid';\\n" if \$pro_fileid ne "";
				print DEST "\\\$pro_license = '\$pro_license';\\n" if \$pro_license ne "";
			}
			if (\$html_flag) {
				foreach \$line (\@source) {
					if (\$line =~ /board-menu\\.html/) {
						\$line = "\$`\$VAR{'html_url'}/board-menu.html\$'";
					} elsif (\$line =~ m|messages/board-topics.html|) {
						\$line = "\$`\$VAR{'html_url'}/messages/board-topics.html\$'";
					} elsif (\$line =~ /board-search.cgi/) {
						\$line = "\$`\$VAR{'script_url'}/board-search.\$VAR{'cgi_extension'}\$'";
					} elsif (\$line =~ /board-viewtree.cgi/) {
						\$line = "\$`\$VAR{'script_url'}/board-viewtree.\$VAR{'cgi_extension'}\$'";
					} elsif (\$line =~ /board-newmessages.cgi/) {
						\$line = "\$`\$VAR{'script_url'}/board-newmessages.\$VAR{'cgi_extension'}\$'";
					} elsif (\$line =~ /board-profile.cgi/) {
						\$line = "\$`\$VAR{'script_url'}/board-profile.\$VAR{'cgi_extension'}\$'";
					} elsif (\$line =~ /board-contact.cgi/) {
						\$line = "\$`\$VAR{'script_url'}/board-contact.\$VAR{'cgi_extension'}\$'";
					} elsif (\$line =~ /board-image-lister.cgi/) {
						\$line = "\$`\$VAR{'script_url'}/board-image-lister.\$VAR{'cgi_extension'}\$'";
					} elsif (\$line =~ /board-admin-menuonly.cgi/) {
						\$line = "\$`\$VAR{'script_url'}/board-admin-menuonly.\$VAR{'cgi_extension'}\$'";
					} elsif (\$line =~ /warning.html/) {
						\$line = "\$`\$VAR{'html_url'}/warning.html\$'";
					} elsif (\$line =~ /\\.\\.\\/clipart\\/board_logo.gif/) {
						\$line = "\$`\$VAR{'html_url'}/clipart/board_logo.gif\$'";
					} elsif (\$line =~ /^<!-Pro-!>/ && \$pro_version == 0) {
						\$line = "";
					} elsif ((\$line =~ m|<!--| || \$line =~ m|-->|) && \$line =~ m|NOFRAMES| && \$VAR{'interface'} eq "noframes") {
						\$line = "";
					}
				}
				\$title = \$VAR{'title'};
				foreach \$line (\@source) {
					\$line =~ s/<!--\\*-->([^!]+)<!--\\/\\*-->/<!--\\*-->\$title<!--\\/\\*-->/g;
					\$line =~ s/<!--TITLE-->([^!]+)<!--\\/TITLE-->/<!--TITLE--><TITLE>\$title<\\/TITLE><!--\\/TITLE-->/g;
				}
			}
			print DEST \@source;
			close (DEST);
			chmod (oct(\$permissions), \$destfile);
		} else {
			print "Warning: Could not write \$destfile: \$!\\n";
			close (SOURCE);
		}		
	} else {
		print "Warning: Could not open \$sourcefile: \$!\\n";
	}
}

_End_Of_Subroutines

	print FILE "# Establish necessary variables\n\n";
	print FILE "\$VAR{'admin_dir'} = '$FORM{'admin_dir'}';\n";
	print FILE "\$VAR{'html_dir'} = '$FORM{'html_dir'}';\n";
	print FILE "\$VAR{'script_dir'} = '$FORM{'script_dir'}';\n";
	print FILE "\$VAR{'admin_dir_'} = '$admin_dir_';\n";
	print FILE "\$VAR{'html_dir_'} = '$html_dir_';\n";
	print FILE "\$VAR{'script_dir_'} = '$script_dir_';\n";
	print FILE "\$VAR{'cgi_extension'} = '$cgi_extension';\n";
	$title =~ s/\\/\\\\/g;
	$title =~ s/"/\\"/g;
	$title =~ s/\@/\\\@/g;
	$title =~ s/\$/\\\$/g;
	print FILE "\$VAR{'title'} = \"$title\";\n";
	srand (time|$$);
	$rn = int(rand(9999));
	$pn = $$; $pn =~ s/\D//g;
	$tm = time; $tm =~ s/\D//g;
	$pro_fileid = join("", $rn, $pn, $tm);
	print FILE "\$pro_fileid = '$pro_fileid';\n";
	print FILE "\$VAR{'interface'} = 'frames';\n" if $FORM{'frames'} ne "no";
	print FILE "\$VAR{'interface'} = 'noframes';\n" if $FORM{'frames'} eq "no";
	print FILE "\$VAR{'html_url'} = '$FORM{'html_url'}';\n";
	print FILE "\$VAR{'script_url'} = '$FORM{'script_url'}';\n";
	print FILE "\$contact = \"$contact\";\n";
	print FILE "\$uninstall_file = '$install_dir/uninstall.pl';\n";
	print FILE "\$pro_version = '$pro_version';\n";
	print FILE "\$chosen_perl = '$chosen_perl';\n";
	print FILE "\$pro_license = '$pro_license';\n";

	print FILE "\n# Create directories / copy files\n\n";
	
	print FILE <<_End_Of_Create;
open (UNINSTALL, ">\$uninstall_file");
close (UNINSTALL);

open (FILELIST, "$install_dir/source/filelist.txt");
\@filelist = <FILELIST>;
close (FILELIST);
\@filelist = grep(/\\S/, \@filelist);
\@filelist = grep(!/^#/, \@filelist);
foreach \$line (\@filelist) {
	if (\$line =~ m|^(\\S+)\\s+(\\S+)\\s+\\[(\\S+)\\]|) {
		(\$perm, \$file, \$param) = (\$1, \$2, \$3);
	} elsif (\$line =~ m|^(\\S+)\\s+(\\S+)|) {
		(\$perm, \$file, \$param) = (\$1, \$2, "");
	} else {
		next;
	}
	next if (\$param =~ m|\\%| && !\$pro_version);
	\$perm =~ m|(.)(.)(.)(.)(.)(.)(.)(.)(.)(.)|;
	(\$dir, \$ur, \$uw, \$ux, \$gr, \$gw, \$gx, \$or, \$ow, \$ox) = (\$1, \$2, \$3, \$4, \$5, \$6, \$7, \$8, \$9, \$10);
	\$uperm = 0; \$gperm = 0; \$operm = 0;
	\$uperm += 4 if \$ur ne "-";
	\$uperm += 2 if \$uw ne "-";
	\$uperm += 1 if \$ux ne "-";
	\$gperm += 4 if \$gr ne "-";
	\$gperm += 2 if \$gw ne "-";
	\$gperm += 1 if \$gx ne "-";
	\$operm += 4 if \$or ne "-";
	\$operm += 2 if \$ow ne "-";
	\$operm += 1 if \$ox ne "-";
	\$perm = "\$uperm\$gperm\$operm";
	if (\$dir ne "d") {
		if (\$file =~ m|^./discus_admin/(.*)|) {
			\$fn = \$1;
			\$destfile = "\$VAR{'admin_dir_'}/\$fn";
			if (\$fn =~ m|(.*)/(\\S+)\\.|) {
				\$source = "src-\$2";
			} elsif (\$fn =~ m|(.*)/(\\S+)|) {
				\$source = "\$2";
			} elsif (\$fn =~ m|(\\S+)\\.|) {
				\$source = "src-\$1";
			} else {
				\$source = \$fn;
			}
			\$flag = &process_file(\$source, \$destfile, \$perm, \$param);
		} elsif (\$file =~ m|^./public_html/(.*)|) {
			\$fn = \$1;
			\$destfile = "\$VAR{'html_dir_'}/\$fn";
			if (\$fn =~ m|(.*)/(\\S+)\\.gif|) {
				\$source = "img-\$2";
			} elsif (\$fn =~ m|(.*)/(\\S+)\\.|) {
				\$source = "src-\$2";
			} elsif (\$fn =~ m|(\\S+)\\.|) {
				\$source = "src-\$1";
			} else {
				\$source = \$fn;
			}
			\$flag = &process_file(\$source, \$destfile, \$perm, \$param);
		} elsif (\$file =~ m|^./cgi-bin/(.*)\\.|) {
			\$fn = \$1 . ".\$VAR{'cgi_extension'}";
			\$destfile = "\$VAR{'script_dir_'}/\$fn";
			if (\$fn =~ m|(\\S+)\\.|) {
				\$source = "src-\$1";
			} else {
				\$source = \$fn;
			}
			\$flag = &process_file(\$source, \$destfile, \$perm, \$param);
		}
		\$destfile .= "_\$pro_fileid" if (\$pro_fileid && \$flag);
		open (UNINSTALL, ">>\$uninstall_file");
		print UNINSTALL "}\\n";
		print UNINSTALL "print \\"\\\$num file(s) removed! \\\$!\\\\n\\";\\n";
		print UNINSTALL "print \\"Removing '\$destfile'\\\\n\\";\\n";
		print UNINSTALL "if (\\\$num == 0) {\\n";
		print UNINSTALL "\\\$num = unlink(\\"\$destfile\\");\\n";
		print UNINSTALL "undef \\\$!;\\n";
		print UNINSTALL "# Delete Destination File: \$destfile\\n";
		close (UNINSTALL);
	} else {
		if (\$file =~ m|^./discus_admin/(.*)|) {
			\$dirname = \$VAR{'admin_dir_'} . "/\$1";
		} elsif (\$file =~ m|^./public_html/(.*)|) {
			\$dirname = \$VAR{'html_dir_'} . "/\$1";
		} elsif (\$file =~ m|^./cgi-bin/(.*)|) {
			\$dirname = \$VAR{'script_dir_'} . "/\$1";
		} elsif (\$file =~ m|^./discus_admin|) {
			\$dirname = \$VAR{'admin_dir_'};
		} elsif (\$file =~ m|^./public_html|) {
			\$dirname = \$VAR{'html_dir_'};
		} elsif (\$file =~ m|^./cgi-bin|) {
			\$dirname = \$VAR{'script_dir_'};
		}			
		if (-e \$dirname) {
			chmod(oct(\$perm), \$dirname);
		} else {
			mkdir (\$dirname, oct(\$perm));
			chmod (oct(\$perm), \$dirname);
		}
		open (UNINSTALL, ">>\$uninstall_file");
		print UNINSTALL "}\\n";
		print UNINSTALL "print \\"\\\$num directory removed! \\\$!\\\\n\\";\\n";
		print UNINSTALL "print \\"Removing '\$dirname'\\\\n\\";\\n";
		print UNINSTALL "if (\\\$num == 0) {\\n";
		print UNINSTALL "\\\$num = rmdir(\\"\$dirname\\");\\n";
		print UNINSTALL "undef \\\$!;\\n";
		print UNINSTALL "# Remove Destination Directory: \$dirname\\n";
		close (UNINSTALL);
	}
}

open (UNINSTALL, ">>\$uninstall_file");
print UNINSTALL "}\\n";
print UNINSTALL "print \\"\\\$num file(s) removed! \\\$!\\\\n\\";\\n";
print UNINSTALL "print \\"Removing '\$destfile'\\\\n\\";\\n";
print UNINSTALL "if (\\\$num == 0) {\\n";
print UNINSTALL "\\\$num = unlink(\\"\$VAR{'admin_dir_'}/discus.conf\\");\\n";
print UNINSTALL "undef \\\$!;\\n";
print UNINSTALL "# Delete Destination File: \$VAR{'admin_dir_'}/discus.conf\\n";
close (UNINSTALL);

open (UNINSTALL, "<\$uninstall_file");
\@uninstall = <UNINSTALL>;
close (UNINSTALL);
open (UNINSTALL, ">\$uninstall_file");
print UNINSTALL "#!$chosen_perl\\n";
print UNINSTALL reverse(\@uninstall);
close (UNINSTALL);

_End_Of_Create

	print FILE "# Set up the discus.conf file\n\n";
	print FILE "open (DC, \">$admin_dir_/discus.conf\");\n";
	print FILE "print DC \"admin_dir=\$VAR{'admin_dir'}\", \"\\n\";\n";
	print FILE "print DC \"html_dir=\$VAR{'html_dir'}\", \"\\n\";\n";
	print FILE "print DC \"script_dir=\$VAR{'script_dir'}\", \"\\n\";\n";
	print FILE "print DC \"admin_dir_=\$VAR{'admin_dir_'}\", \"\\n\";\n";
	print FILE "print DC \"html_dir_=\$VAR{'html_dir_'}\", \"\\n\";\n";
	print FILE "print DC \"script_dir_=\$VAR{'script_dir_'}\", \"\\n\";\n";
	print FILE "print DC \"html_url=\$VAR{'html_url'}\", \"\\n\";\n";
	print FILE "print DC \"script_url=\$VAR{'script_url'}\", \"\\n\";\n";
	print FILE "print DC \"ext=html\", \"\\n\";\n";
	print FILE "print DC \"superuser=admin\", \"\\n\";\n";
	print FILE "print DC \"cgi_extension=$cgi_extension\", \"\\n\";\n";
	print FILE "print DC \"title=\$title\", \"\\n\";\n";
	print FILE "print DC \"version=$DISCUS_VERSION\", \"\\n\";\n";
	print FILE "print DC \"pro=$pro_version\", \"\\n\";\n";
	print FILE "print DC \"interface=\$VAR{'interface'}\", \"\\n\";\n";
	print FILE "print DC \"contact=\$contact\", \"\\n\";\n";
	print FILE "print DC \"language_chosen=\$language_chosen\", \"\\n\" if \$language_chosen;\n";
	if ($unix) {
		print FILE "print DC \"platform=Unix\", \"\\n\";\n";
	} elsif ($nt) {
		print FILE "print DC \"platform=NT\", \"\\n\";\n";
	} elsif ($win95) {
		print FILE "print DC \"platform=win95\", \"\\n\";\n";
	} else {
		print FILE "print DC \"platform=NT\", \"\\n\";\n";
	}
	print FILE "close (DC);\n\n";
	print FILE "# This is version $this_version_of_discus_is\n";
	print FILE "open (UP, \">$admin_dir_/upgrade.txt\");\n";
	print FILE "print UP \"New installation of version $this_version_of_discus_is\\n\";\n";
	print FILE "print UP \"Complete: version $this_version_of_discus_is\\n\";\n";
	print FILE "print UP \"------------------------------------\\n\";\n";
	print FILE "close (UP);\n";
	close (FILE);

}

########################################################
# MISCELLANEOUS SUBROUTINES USED FOR VARIOUS TASKS
	
sub parse_form {
	read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
	@pairs = split(/&/, $buffer);
	foreach $pair (@pairs) {
		($name, $value) = split(/=/, $pair);
		$value =~ tr/+/ /;
		$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
		$value =~ s/\r//g;
		$FORM{$name} = $value;
	}
}
	
sub give_up {
	print "Content-type: text/html\n\n";
	print "<HTML><HEAD><TITLE>Setup Error</TITLE></HEAD>\n";
	print "<BODY BGCOLOR=#c0c0c0 TEXT=#000000 LINK=#0000ff VLINK=#0000ff>\n";
	print "<H1>Setup Error</H1>\n";
	print "The server could not determine its current working directory, and it cannot see the 'install.pl' file that was created when the setup script was run.  This is because:\n";
	print "<UL><LI>Directory permissions prohibit the server from accessing files in '$install_dir', <B>or</B>\n";
	print "<LI>Your server is running in a 'chroot'-ed environment, which means that the server sees a different directory structure than you see when you log in through telnet.</UL>\n";
	print "<P>Consult your server administrator, and ask him or her to tell you the directory path that your server sees.  Do not contact Discus technical support with this problem, because we won't be able to help -- sorry!\n";
	print "</BODY></HTML>\n";
	exit(0);
}
	
sub error_message {
	local ($message) = @_;
	print "Content-type: text/html\n\n";
	print "<HTML><HEAD><TITLE>Setup Error</TITLE></HEAD>\n";
	print "<BODY BGCOLOR=#c0c0c0 TEXT=#000000 LINK=#0000ff VLINK=#0000ff>\n";
	print "<H1>Setup Error</H1>\n";
	print "<B>$message</B>.  Please correct the error on the previous form and resubmit.";
	print "</BODY></HTML>\n";
	exit(0);
}
	
##########################
# End of src-board-setup #
##########################
##################################################
# WWW SETUP FORM CODE READ FROM src-setup-1


sub display_form {
	print "Content-type: text/html\n\n";
print "<HTML>\n";
print "<HEAD>\n";
print "<TITLE>Discus WWW Setup Form</TITLE>\n";
print "</HEAD>\n";
print "<BODY BGCOLOR=#ffffff TEXT=#000000 LINK=#0000ff VLINK=#0000ff ALINK=#ff0000>\n";
print "\n";
print "<TABLE WIDTH=85%><TR><TD>\n";
print "<TABLE WIDTH=100% BGCOLOR=#0000aa>\n";
print "<TR><TD ALIGN=CENTER><FONT FACE=\"Bookman Old Style,Times New Roman\" SIZE=6 COLOR=#ffffff><B><I>Discus</I> Setup for UNIX</B></FONT></TD></TR></TABLE>\n";
print "</CENTER>\n";
print "<P>\n";
print "<FORM ACTION=\"board-setup.$cgi_extension\" METHOD=POST>\n";
print "<INPUT TYPE=HIDDEN NAME=action VALUE=setup>\n";
print "<INPUT TYPE=HIDDEN NAME=prepend VALUE=\"$prepend\">\n";
print "<INPUT TYPE=HIDDEN NAME=svr_prepend VALUE=\"$svr_prepend\">\n";
print "<TABLE BGCOLOR=#ffffcc WIDTH=100%><TR><TD><FONT FACE=\"Bookman Old Style\" SIZE=3><B>Introduction</B></FONT></TD></TR></TABLE>\n";
print "<P>\n";
print "Welcome to Discus setup.  This form is designed to assist you with installation\n";
print "into your home directory, so your Discus board will be accessible at a URL like\n";
print "the following: <FONT FACE=\"Courier New\" SIZE=2>http://$ENV{'HTTP_HOST'}/~$uid/discus</FONT>.  Please follow all directions on this form carefully.\n";
print "<P>\n";
print "Discus technical support has prepared a graphic that may assist you in visualizing your directory structure.  You may access this graphic <A HREF=\"http://www.chem.hope.edu/discus/install-homedir.html\">from this link</A>.  We encourage\n";
print "you to visit this graphic, especially if you are having problems.\n";
print "<P>\n";
print "\n";
print "<TABLE BGCOLOR=#ffffcc WIDTH=100%><TR><TD><FONT FACE=\"Bookman Old Style\" SIZE=3><B>Administration Directory</B></FONT></TD></TR></TABLE>\n";
print "<P>\n";
print "The administration directory will contain password files, configuration files, and source files.  This directory does not need to be accessed at a URL on your web site -- in fact, if possible, the administration directory should not be accessible at any URL on your web site.\n";
print "<P>\n";
print "<TABLE BGCOLOR=#ffcccc WIDTH=100%><TR><TD><FONT FACE=\"Bookman Old Style\" SIZE=3><B>Example</B></FONT><BR><FONT FACE=\"Courier New\" SIZE=2>\n";
print "<P>\n";
print "If your home directory is <B>$home</B>, you could choose <B>$home/discus_admin</B> as your administration files directory.\n";
print "</FONT></TD></TR></TABLE>\n";
print "<TABLE BGCOLOR=#ccccff WIDTH=100%><TR><TD><FONT FACE=\"Bookman Old Style\" SIZE=2><B>Specify Administration Directory</B></FONT><BR><FONT FACE=\"Courier New\" SIZE=2>\n";
print "<P>\n";
print "<B>$prepend</B></FONT>\n";
print "<INPUT TYPE=TEXT SIZE=40 NAME=admin_dir VALUE=\"\">\n";
print "</TD></TR></TABLE>\n";
print "\n";
print "<P>\n";
print "\n";
print "<TABLE BGCOLOR=#ffffcc WIDTH=100%><TR><TD><FONT FACE=\"Bookman Old Style\" SIZE=3><B>HTML Directory and URL</B></FONT></TD></TR></TABLE>\n";
print "<P>\n";
print "The HTML directory will contain all program documentation, message files, uploaded images, clipart, and icons.  The HTML directory must be accessible by your server (it must exist within the server's webspace).  This should <U>not</U> be installed under your server's cgi-bin directory or within your own personal cgi-bin directory.  The HTML URL should start with <B>http://</B> and should contain the full name of your web server (reported as <B>$ENV{'HTTP_HOST'}</B>).\n";
print "<P>\n";
print "<TABLE BGCOLOR=#ffcccc WIDTH=100%><TR><TD><FONT FACE=\"Bookman Old Style\" SIZE=3><B>Example</B></FONT><BR><FONT FACE=\"Courier New\" SIZE=2>\n";
print "<P>\n";
print "If your home directory is <B>$home</B>, and your web documents are stored in a subdirectory called <B>$www_subdir</B>, you could make your HTML directory be <B>$home/$www_subdir/discus</B>.  A corresponding HTML URL might then be <B>http://$ENV{'HTTP_HOST'}/~$uid/discus</B>.\n";
print "</FONT></TD></TR></TABLE>\n";
print "<TABLE BGCOLOR=#ccccff WIDTH=100%><TR><TD>\n";
print "<FONT FACE=\"Bookman Old Style\" SIZE=2><B>Specify HTML Directory</B></FONT><BR><FONT FACE=\"Courier New\" SIZE=2>\n";
print "<P>\n";
print "<B>$prepend</B></FONT>\n";
print "<INPUT TYPE=TEXT SIZE=40 NAME=html_dir VALUE=\"\">\n";
print "<P>\n";
print "<FONT FACE=\"Bookman Old Style\" SIZE=2><B>Specify HTML URL</B></FONT><BR><FONT FACE=\"Courier New\" SIZE=2>\n";
print "<P>\n";
print "</FONT>\n";
print "<INPUT TYPE=TEXT SIZE=40 NAME=html_url VALUE=\"http://$ENV{'HTTP_HOST'}\">\n";
print "</TD></TR></TABLE>\n";
print "\n";
print "<P>\n";
print "<TABLE BGCOLOR=#ffffcc WIDTH=100%><TR><TD><FONT FACE=\"Bookman Old Style\" SIZE=3><B>Script Directory and URL</B></FONT></TD></TR></TABLE>\n";
print "<P>\n";
print "The Script Directory will contain the CGI scripts that are used to power the Discus program.  Note that this may need to be a special CGI directory on your server or a special directory within your webspace.  The Script URL should start with <B>http://</B> and should contain the full name of your web server (reported as <B>$ENV{'HTTP_HOST'}</B>).\n";
print "<P>\n";
print "<TABLE BGCOLOR=#ffcccc WIDTH=100%><TR><TD><FONT FACE=\"Bookman Old Style\" SIZE=3><B>Example</B></FONT><BR><FONT FACE=\"Courier New\" SIZE=2>\n";
print "<P>\n";
print "If your home directory is <B>$home</B>, and your script files are stored in a subdirectory called <B>$www_subdir/cgi-bin</B>, you could make your Script Directory be <B>$home/$www_subdir/cgi-bin/discus</B>.  A corresponding Script URL might then be <B>http://$ENV{'HTTP_HOST'}/~$uid/cgi-bin/discus</B>.  Running through CGIWrap, your Script URL might be <B>http://$ENV{'HTTP_HOST'}/cgi-bin/cgiwrap/$uid/discus</B>.\n";
print "</FONT></TD></TR></TABLE>\n";
print "<TABLE BGCOLOR=#ccccff WIDTH=100%><TR><TD>\n";
print "<FONT FACE=\"Bookman Old Style\" SIZE=2><B>Specify Script Directory</B></FONT><BR><FONT FACE=\"Courier New\" SIZE=2>\n";
print "<P>\n";
print "<B>$prepend</B></FONT>\n";
print "<INPUT TYPE=TEXT SIZE=40 NAME=script_dir VALUE=\"\">\n";
print "<P>\n";
print "<FONT FACE=\"Bookman Old Style\" SIZE=2><B>Specify Script URL</B></FONT><BR><FONT FACE=\"Courier New\" SIZE=2>\n";
print "<P>\n";
print "</FONT>\n";
print "<INPUT TYPE=TEXT SIZE=40 NAME=script_url VALUE=\"http://$ENV{'HTTP_HOST'}\">\n";
print "</TD></TR></TABLE>\n";
print "\n";
print "<P>\n";
print "<TABLE BGCOLOR=#ffffcc WIDTH=100%><TR><TD><FONT FACE=\"Bookman Old Style\" SIZE=3><B>Customize Your Board</B></FONT></TD></TR></TABLE>\n";
print "<P>\n";
print "This section allows you to customize your board by specifying the board title and contact person.  The board title is used several places throughout the board, including on documentation pages and in the CGI scripts.  The contact person will be displayed if there is an error.  You can also choose to install the \"frames\" or the \"no frames\" interface.\n";
print "<P>\n";
print "<TABLE BGCOLOR=#ccccff WIDTH=100%><TR><TD>\n";
print "<FONT FACE=\"Bookman Old Style\" SIZE=2><B>Specify Board Title</B></FONT><BR><FONT FACE=\"Courier New\" SIZE=2>\n";
print "<P>\n";
print "</FONT>\n";
print "<INPUT TYPE=TEXT SIZE=40 NAME=title VALUE=\"\">\n";
print "<P>\n";
print "<FONT FACE=\"Bookman Old Style\" SIZE=2><B>Specify Contact Person's Name</B></FONT><BR><FONT FACE=\"Courier New\" SIZE=2>\n";
print "<P>\n";
print "</FONT>\n";
print "<INPUT TYPE=TEXT SIZE=40 NAME=contact_name VALUE=\"$your_name\">\n";
print "<P>\n";
print "<FONT FACE=\"Bookman Old Style\" SIZE=2><B>Specify Contact Person's E-mail Address</B></FONT><BR><FONT FACE=\"Courier New\" SIZE=2>\n";
print "<P>\n";
print "</FONT>\n";
print "<INPUT TYPE=TEXT SIZE=40 NAME=contact_email VALUE=\"$uid\@$hostname\">\n";
print "<P>\n";
print "<FONT FACE=\"Bookman Old Style\" SIZE=2><B>Use frames or no frames interface?</B></FONT><BR><FONT FACE=\"Courier New\" SIZE=2>\n";
print "<P>\n";
print "</FONT>\n";
print "<UL>\n";
print "<INPUT TYPE=RADIO NAME=frames VALUE=yes CHECKED> Frames<BR>\n";
print "<INPUT TYPE=RADIO NAME=frames VALUE=no> No Frames<BR>\n";
print "</UL>\n";
print "<P>\n";
print "</TD></TR></TABLE>\n";
print "<P>\n";
print "\n";
print "<INPUT TYPE=HIDDEN NAME=ssi VALUE=\"no\">\n";
print "\n";
print "<TABLE BGCOLOR=#ffffcc WIDTH=100%><TR><TD><FONT FACE=\"Bookman Old Style\" SIZE=3><B>Submit Form</B></FONT></TD></TR></TABLE>\n";
print "<P>\n";
print "After verifying the information in the form above, you can submit the form to complete this step of the installation process.\n";
print "<P>\n";
print "<CENTER>\n";
print "<INPUT TYPE=SUBMIT VALUE=\"Submit Form\">\n";
print "</CENTER>\n";
print "</TD></TR></TABLE>\n";
print "</FORM>\n";
print "</BODY>\n";
print "</HTML>\n";
}