######################################################## # 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!
Discus Setup$platform

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><!--\\/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 = <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 "<HTML><HEAD><TITLE>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 "\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 # ##########################