########################################################
# File: src-board-setup
# Copyright (c) 1998 by Kevin Paulisse and William Polik
# This is the source for the Discus WWW setup script...
########################################################
########################################################
# 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;
$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) {
$tries = "/bin /usr/bin /usr/local/bin /sbin /usr/sbin /usr/local/sbin /usr/lib";
$tries .= " /etc /usr/local/etc /usr/etc /usr/local/lib";
@tries = split(/\s/, $tries);
foreach $try (@tries) {
if (-e "$try/sendmail" && -x "$try/sendmail") {
$sendmail_path = "$try";
last;
}
}
foreach $try (@tries) {
if (-e "$try/mail" && -x "$try/mail") {
$mail_path = "$try";
last;
}
}
$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);
}
# Test e-mail notification
if ($FORM{'action'} eq "testemail") {
$FORM{'path'} =~ s/^\s+//;
$FORM{'path'} =~ s/\s+$//;
if ($FORM{'mailer'} eq "sendmail") {
$FORM{'path'} =~ s/\/sendmail$//;
$FORM{'path'} =~ s/\/$//;
$FORM{'path'} .= "/sendmail";
$| = 1;
if (-e "$FORM{'path'}") {
if (open(MAIL, "| $FORM{'path'} -t")) {
print MAIL "To: discustest\@www.chem.hope.edu\n";
print MAIL "From: Discus Testing <$uid\@$hostname>\n";
print MAIL "Subject: Test e-mail notification\n\n";
print MAIL "---", $$, "---", "\n";
close (MAIL);
} else {
print "Content-type: text/html\n\n";
print "
Failure \n";
print "Could not open sendmail: $! $@\n";
exit(0);
}
} else {
print "Content-type: text/html\n\n";
print "Failure \n";
print "Sendmail does not exist at that path.\n";
exit(0);
}
} elsif ($FORM{'mailer'} eq "mail") {
$FORM{'path'} =~ s/\/mail$//;
$FORM{'path'} =~ s/\/$//;
$FORM{'path'} .= "/mail";
if (-e "$FORM{'path'}") {
if (open(MAIL, "| $FORM{'path'} discustest\@www.chem.hope.edu -s 'Test e-mail notification'")) {
print MAIL "---", $$, "---", "\n";
close (MAIL);
} else {
print "Content-type: text/html\n\n";
print "Failure \n";
print "Could not open mail: $! $@\n";
exit(0);
}
} else {
print "Content-type: text/html\n\n";
print "Failure \n";
print "Mail does not exist at that path.\n";
exit(0);
}
} else {
print "Content-type: text/html\n\n";
print "Failure \n";
print "Invalid mailer was specified.\n";
exit(0);
}
print "Content-type: text/html\n\n";
print "Success \n";
print "Your message was successfully sent. Please wait ten seconds and then verify that your message was\n";
print "received by following this link .";
exit(0);
}
# Receive User Input, write to "install.pl"
$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";
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 ne "/") {
$dir =~ m|(.*)/(.*)|;
$parent = $1; $newname = $2;
if (!-e "$parent") {
&error_message("'$parent' does not exist as a directory (in the specification of $dir_key ).");
}
if ($newname =~ /[^\w\-\+ \.]/) {
&error_message("'$newname' is not valid as a directory (in the specification of $dir_key ).");
}
}
$FORM{$dir_key} = $dir;
}
########################################################
# 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|^http://|i) {
&error_message("'$url' does not start with 'http://' in specification of $url_key.");
}
}
########################################################
# CUSTOMIZED SETTINGS #
########################################################
$title = $FORM{'title'};
$title =~ s/!//g;
$title =~ s/\\'/'/g;
$title =~ s/\//\\\//g;
if ($title eq "") {
$title = "Discus";
}
$title_stripped = $title;
$title_stripped =~ s/<([^>]*)>//g;
$ssi_ext = "html";
$remove_ssi = 1;
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'}";
}
&make_directory($admin_dir_, "0755");
$cemail = $FORM{'contact_email'};
$cemail =~ s/@/\\@/g;
$contact = "$FORM{'contact_name'} ";
$config_file = "$FORM{'admin_dir'}/discus.conf";
&config_change("html_dir", "$FORM{'html_dir'}");
&config_change("admin_dir", "$FORM{'admin_dir'}");
&config_change("script_dir", "$FORM{'script_dir'}");
&config_change("html_url", "$FORM{'html_url'}");
&config_change("script_url", "$FORM{'script_url'}");
&config_change("title", "$FORM{'title'}");
&config_change("version", "$this_version");
&config_change("contact", $contact);
&config_change("superuser", "admin");
&config_change("version", $DISCUS_VERSION);
&config_change("dynamic_navbar", 1) if $remove_ssi == 0;
&config_change("dynamic_navbar", 0) if $remove_ssi == 1;
&config_change("platform", "NT") if $winnt == 1;
&config_change("platform", "Win95") if $win95 == 1;
&config_change("platform", "Unix") if $unix == 1;
&config_change("platform", "Unknown") if ($winnt == 0 && $win95 == 0 && $unix == 0);
&config_change("ext", $ssi_ext);
&config_change("cgi_extension", "$cgi_extension");
&config_change("ssi_method", "$ssi_method");
if ($prepend) {
&config_change("admin_dir_", "$prepend$FORM{'admin_dir'}");
&config_change("html_dir_", "$prepend$FORM{'html_dir'}");
&config_change("script_dir_", "$prepend$FORM{'script_dir'}");
}
if ($FORM{'mailer'} eq "sendmail") {
$mailprog = $FORM{'sendmail'};
$mailprog =~ s/\/sendmail$//;
$mailprog =~ s/\/$//;
$mailprog .= "/sendmail";
if (-e "$mailprog") {
&config_change("mailprog", $mailprog);
&config_change("email_notification", 1);
} else {
&config_change("mailprog", "");
&config_change("email_notification", 0);
}
} elsif ($FORM{'mailer'} eq "mail") {
$mailprog = $FORM{'mail'};
$mailprog =~ s/\/mail$//;
$mailprog =~ s/\/$//;
$mailprog .= "/mail";
if (-e "$mailprog") {
&config_change("mailprog", $mailprog);
&config_change("email_notification", 1);
} else {
&config_change("mailprog", "");
&config_change("email_notification", 0);
}
} else {
&config_change("mailprog", "");
&config_change("email_notification", 0);
}
&make_directory($html_dir_, "0755");
@html = ("board-menu", "warning", "admin", "board", "board-instructions", "board-about", "board-formatting", "board-troubleshooting", "board-faq");
for ($i = 1; $i <= 12; $i++) {
push (@html, "board-admin-instr-$i");
}
foreach $file (@html) {
©_file("./source/src-$file", "$html_dir_/$file.html", 0, 0, 0, 0, $remove_ssi, 1, 644, 0);
}
&make_directory("$html_dir_/messages", "0777");
©_file("./source/src-board-topics", "$html_dir_/messages/board-topics.html", 0, 0, 0, 0, 0, 1, 666, 0);
@clipart = ("board_logo", "new", "smile", "triangle_down", "triangle_right", "your_image");
&make_directory("$html_dir_/clipart", "0755");
foreach $file (@clipart) {
©_file("./source/img-$file", "$html_dir_/clipart/$file.gif", 0, 0, 0, 0, 0, 0, 644, 1);
}
$files = "yellowbg,delete_icon,edit_icon,group_icon,group_icon_add,group_icon_remove,help_icon,info_icon,link_icon,mark_down,mark_up,move_icon,next_button,prev_button,properties_icon,rename_icon,reorder_icon,top_button,tree_a,tree_b,tree_c,tree_d,tree_e,tree_f,tree_g,tree_h,tree_i,tree_j,tree_k,tree_l,view_icon";
@icons = split(/,/, $files);
&make_directory("$html_dir_/icons", "0755");
foreach $file (@icons) {
©_file("./source/img-$file", "$html_dir_/icons/$file.gif", 0, 0, 0, 0, 0, 0, 644, 1);
}
&make_directory("$admin_dir_/source", "0755");
$files = "src-board-subs-common,";
for($i = 1; $i <= 9; $i++) {
$files .= "src-board-subs-$i,";
}
@source = split(/,/, $files);
foreach $file (@source) {
if ($file =~ /\S/) {
©_file("./source/$file", "$admin_dir_/source/$file", 0, 1, 1-$implemented_flock, 1-$implemented_chmod, 0, 0, 644, 0);
}
}
&make_directory("$script_dir_", "0755");
$files = "board-admin,board-admin-menuonly,board-post,board-post-form,";
$files .= "board-image,board-image-lister,board-search,board-contact,";
$files .= "board-viewtree,board-profile,board-newmessages,show";
@files = split(/,/, $files);
foreach $file (@files) {
©_file("./source/src-$file", "$script_dir_/$file.$cgi_extension", 1, 0, 1-$implemented_flock, 1-$implemented_chmod, 0, 0, 755, 0);
}
$FORM{'contact_name'} =~ s/://g;
$cemail =~ s/://g;
$FORM{'contact_name'} =~ s/\n|\r//g;
$cemail =~ s/\n|\r//g;
&generate("$admin_dir_/passwd.txt", "admin" . "::$cemail:$FORM{'contact_name'}:1:0:0", 666);
&generate("$admin_dir_/users.txt", "", 666);
&generate("$admin_dir_/data.txt", "0", 666);
&generate("$admin_dir_/log.txt", "", 666);
&generate("$admin_dir_/postindex.txt", "0", 666);
&generate("$admin_dir_/admin.log", "", 666);
&generate("$admin_dir_/groups.txt", "", 666);
&generate("$admin_dir_/frontpage_conf.txt", "Bold=1\nGroup=0\nDate=1\n", 666);
&generate("$admin_dir_/locks.txt", "", 666);
$files = "addmessage-private,addmessage-public";
@files = split(/,/, $files);
foreach $file (@files) {
©_file("./source/src-$file", "$admin_dir_/$file.txt", 0, 0, 0, 0, 0, 0, 644, 0);
}
©_file("./source/src-webtags", "$admin_dir_/webtags.conf", 0, 0, 0, 0, 0, 0, 644, 0);
©_file("./source/src-language", "$admin_dir_/language.conf", 0, 0, 0, 0, 0, 0, 644, 0);
if ($FORM{'frames'} eq "yes") {
©_file("./source/src-newpage-frames", "$FORM{'admin_dir'}/newpage.txt", 0, 0, 0, 0, 0, 0, 644, 0);
©_file("./source/src-board", "$html_dir_/index.html", 0, 0, 0, 0, 0, 1, 644, 0, 1);
©_file("./source/src-board", "$html_dir_/default.htm", 0, 0, 0, 0, 0, 1, 644, 0, 1);
&config_change("interface","frames");
} else {
©_file("./source/src-newpage-noframes", "$FORM{'admin_dir'}/newpage.txt", 0, 0, 0, 0, 0, 0, 644, 0);
©_file("./source/src-board-refresh", "$html_dir_/index.html", 0, 0, 0, 0, 0, 1, 644, 0, 1);
©_file("./source/src-board-refresh", "$html_dir_/default.htm", 0, 0, 0, 0, 0, 1, 644, 0, 1);
open (FILE, ">>$install_pl");
print FILE "\$bgimage = '$FORM{'html_url'}/icons/yellowbg.gif';\n";
close (FILE);
&config_change("interface","noframes");
}
########################################################
# SOME CONCLUDING THINGS FOR FILES #
########################################################
open (SCR, ">>$uninstall_pl");
eval 'flock(SCR, 2);' if $implemented_flock;
print SCR "# Remove Symbolic Link\n";
print SCR "unlink(\"$html_dir_/index.html\") || print \"Warning: Could not remove index.html: \$! \$\@\\n\";\n";
print SCR "\n";
foreach $dir (reverse(@dirs_made)) {
print SCR "# Remove directory: $dir\n";
print SCR "rmdir(\"$dir\") || print \"Warning: Could not remove $dir: \$! \$\@\\n\";\n";
print SCR "\n";
}
eval 'flock(SCR, 8);' if $implemented_flock;
close (SCR);
open (FILE, ">>$install_pl");
print FILE <;
close (FILE);
\$/ = \$slash;
eval \$file;
EOF
close (FILE);
########################################################
# YAY!!! #
########################################################
open (FILE, ">>$install_pl");
print FILE <;
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_;
Discus WWW Setup Form - SUCCESS!
Success!
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 $FORM{'title'} will be up and running.
Specifically, here is the procedure:
_End_Of_YAY_
if ($unix) {
print "
cd $ch_d\nperl install.pl
\n";
} else {
print "Start a MS-DOS prompt and enter these commands:
\n";
$ch_d_2 = $ch_d; $ch_d =~ s/\//\\/g;
$drive = substr($ch_d_2,0,2);
print "
$drive\ncd $ch_d_2\nperl install.pl
\n";
print "
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_;
AFTER YOU HAVE RUN install.pl , you may go to $FORM{'title'} .
_End_Of_YAY_2_
exit(0);
########################################################
# COPY FILES
sub copy_file {
local ($source_fn, $final_fn, $is_script, $is_source, $remove_flock, $remove_chmod, $remove_ssi, $is_html, $perm, $binary, $owwarn) = @_;
open (INSTPL, ">>$install_pl");
eval 'flock(INSTPL, 2);' if $implemented_flock;
print INSTPL "###################################################\n";
print INSTPL "# Copy $source_fn -> $final_fn\n\n";
if ($owwarn) {
print INSTPL "if (!-e '$final_fn') {\n";
}
print INSTPL <<_End_Open_Code;
open(SOURCE, "$source_fn") || print "Warning: Could not open $source_fn: \$! \$\@\\n";
_End_Open_Code
print INSTPL "eval 'binmode(SOURCE);';\n" if $binary;
print INSTPL <<_End_Open_Code;
\@source = ;
close (SOURCE);
open (DEST, ">$final_fn") || print "Warning: Could not write $final_fn: \$! \$\@\\n";;
_End_Open_Code
print INSTPL "flock (DEST, 2);\n" if $implemented_flock;
print INSTPL "eval 'binmode(DEST);';\n" if $binary;
print INSTPL '@source = grep(!/^(\s*)flock\s?\(\w+\s?,\s?\d\);/, @source);',"\n" if $remove_flock;
print INSTPL '@source = grep(!/^(\s*)chmod\s?\(\d+,/, @source);',"\n" if $remove_chmod;
if ($is_script) {
print INSTPL "print DEST \"#!$chosen_perl\\n\";\n";
print INSTPL "print DEST \"\\\$discus_conf = '$FORM{'admin_dir'}/discus.conf';\\n\";\n";
}
if ($is_html) {
print INSTPL <<_End_Of_HTML_Updates;
foreach \$line (\@source) {
if (\$line =~ /board-menu\\.html/) {
\$line = "\$`$FORM{'html_url'}/board-menu.html\$'";
} elsif (\$line =~ m|messages/board-topics.html|) {
\$line = "\$`$FORM{'html_url'}/messages/board-topics.html\$'";
} elsif (\$line =~ m|warning.html|) {
\$line = "\$`$FORM{'html_url'}/warning.html\$'";
} elsif (\$line =~ /board-search.cgi/) {
\$line = "\$`$FORM{'script_url'}/board-search.$cgi_extension\$'";
} elsif (\$line =~ /board-newmessages.cgi/) {
\$line = "\$`$FORM{'script_url'}/board-newmessages.$cgi_extension\$'";
} elsif (\$line =~ /board-profile.cgi/) {
\$line = "\$`$FORM{'script_url'}/board-profile.$cgi_extension\$'";
} elsif (\$line =~ /board-contact.cgi/) {
\$line = "\$`$FORM{'script_url'}/board-contact.$cgi_extension\$'";
} elsif (\$line =~ /board-image-lister.cgi/) {
\$line = "\$`$FORM{'script_url'}/board-image-lister.$cgi_extension\$'";
} elsif (\$line =~ /board-admin-menuonly.cgi/) {
\$line = "\$`$FORM{'script_url'}/board-admin-menuonly.$cgi_extension\$'";
} elsif (\$line =~ /board-viewtree.cgi/) {
\$line = "\$`$FORM{'script_url'}/board-viewtree.$cgi_extension\$'";
} elsif (\$line =~ /\\.\\.\\/clipart\\/board_logo.gif/) {
\$line = "\$`$FORM{'html_url'}/clipart/board_logo.gif\$'";
}
}
foreach \$line (\@source) {
\$line =~ s/([^!]+)/$title/g;
\$line =~ s/([^!]+)/$title_stripped<\\/TITLE>/g;
}
_End_Of_HTML_Updates
}
print INSTPL "print DEST \@source;\n";
if ($is_script || $is_source) {
print INSTPL "print DEST \"\\r\\n\";" if $windows;
print INSTPL "print DEST \"\\n\";" if $unix;
}
print INSTPL "flock (DEST, 8);\n" if $implemented_flock;
print INSTPL "close (DEST);\n";
print INSTPL "chmod(0$perm, '$final_fn');\n" if $implemented_chmod;
if ($owwarn) {
print INSTPL "}\n";
}
print INSTPL "\n";
eval 'flock(INSTPL, 8);' if $implemented_flock;
close (INSTPL);
open (SCR, ">>$cleanup_pl");
eval 'flock(SCR, 2);' if $implemented_flock;
print SCR "# Remove source file: $source_fn\n";
print SCR "unlink(\"$source_fn\");\n";
print SCR "\n";
eval 'flock(SCR, 8);' if $implemented_flock;
close (SCR);
open (SCR, ">>$uninstall_pl");
eval 'flock(SCR, 2);' if $implemented_flock;
print SCR "# Remove destination file: $final_fn\n";
print SCR "unlink(\"$final_fn\");\n";
print SCR "\n";
eval 'flock(SCR, 8);' if $implemented_flock;
close (SCR);
}
sub make_directory {
local ($directory, $permissions) = @_;
open (INSTPL, ">>$install_pl");
print INSTPL "# Make '$directory'\n";
print INSTPL "if (!(-e \"$directory\")) {\n";
print INSTPL " if (!(mkdir(\"$directory\", $permissions))) {\n";
print INSTPL " print \"ERROR! Could not create $directory.\\n\";\n";
print INSTPL " exit(0);\n";
print INSTPL " }\n";
print INSTPL " chmod($permissions, \"$directory\");\n";
print INSTPL "}\n\n";
close (INSTPL);
push (@dirs_made, $directory);
}
sub config_change {
local ($variable, $value) = @_;
local (@file, $line, $change);
open (FILE, ">>$install_pl");
print FILE "# Set '$variable' to '$value'\n";
print FILE "open (FILE, \"$config_file\");\n";
print FILE "\@file = ;\n";
print FILE "close (FILE);\n";
print FILE "\$change = 0;\n";
print FILE "foreach \$line (\@file) {\n";
print FILE " if (\$line =~ /$variable=(.*)/) {\n";
print FILE " \$line = \"$variable=$value\\n\";\n";
print FILE " \$change = 1;\n";
print FILE " }\n";
print FILE "}\n";
print FILE "if (\$change == 0) {\n";
print FILE " open (FILE, \">>$config_file\");\n";
print FILE " flock (FILE, 2);\n" if $implemented_flock;
print FILE " print FILE \"$variable=$value\\n\";\n";
print FILE " flock (FILE, 8);\n" if $implemented_flock;
print FILE " close (FILE);\n";
print FILE "} else {\n";
print FILE " open (FILE, \">$config_file\");\n";
print FILE " flock (FILE, 2);\n" if $implemented_flock;
print FILE " print FILE \@file;\n";
print FILE " flock (FILE, 8);\n" if $implemented_flock;
print FILE " close (FILE);\n";
print FILE "}\n";
print FILE "\n";
close (FILE);
}
sub generate {
local ($filename, $text, $permissions) = @_;
open (FILE, ">>$install_pl");
print FILE <<_End_generate;
if (!(-e "$filename")) {
open (FILE, ">$filename");
print FILE "$text";
close (FILE);
_End_generate
print FILE " chmod(0$permissions, \"$filename\");\n" if $implemented_chmod;
print FILE "}\n";
close (FILE);
open (SCR, ">>$uninstall_pl");
print SCR "# Remove destination file: $filename\n";
print SCR "unlink(\"$filename\");\n";
print SCR "\n";
eval 'flock(SCR, 8);' if $implemented_flock;
close (SCR);
}
########################################################
# 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 "Setup Error \n";
print "\n";
print "Setup Error \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 "Directory permissions prohibit the server from accessing files in '$install_dir', or \n";
print " 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. \n";
print "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 "\n";
exit(0);
}
sub error_message {
local ($message) = @_;
print "Content-type: text/html\n\n";
print "
Setup Error \n";
print "\n";
print "Setup Error \n";
print "$message . Please correct the error on the previous form and resubmit.";
print "\n";
exit(0);
}
##########################
# End of src-board-setup #
##########################