# FILE: src-board-subs-common
#-------------------------------------------------------------------------------
# This script is copyright (c) 1998 by DiscusWare, LLC, all rights reserved.
# Its use is subject to the license agreement that can be found at the following
# URL: http://www.chem.hope.edu/discus/license
#-------------------------------------------------------------------------------
#
# The following indicates the version information for this distribution.
# This is available to you through the Version Manager.
$release_version = "3.00";
$free_revision = "3";
$pro_revision = "p5";
#-------------------------------------------------------------------------------
$url_to_default_image = "$html_url/clipart/your_image.gif";
$titlej = &JavaScript_prepare($title);
$message_dir = "$html_dir/messages";
$message_url = "$html_url/messages";
$cgiurl = "$script_url/board-admin.$cgi_extension";
$cgiurl1 = "$script_url/board-admin-1.$cgi_extension";
$cgiurl2 = "$script_url/board-admin-2.$cgi_extension";
$cgiurl3 = "$script_url/board-admin-3.$cgi_extension";
$cgiurlm = "$script_url/board-admin-menuonly.$cgi_extension";
$secdir = "$admin_dir/secure";
sub header {
print "Content-type: text/html\n\n";
}
$fs = "";
undef %GLOBAL_OPTIONS;
undef %FORM;
undef %COOKIE;
open (OPT, "$admin_dir/options.txt"); @opt = ; close (OPT);
foreach $line (@opt) {
if ($line =~ m|^(\w+)=(.*)|) {
$GLOBAL_OPTIONS{$1} = $2;
}
}
&read_declarations;
undef %ev;
sub ex {
local ($function_name) = shift (@_);
local (@params, @file, $o);
@params = @_;
local ($tmp, $file, $num, $sub, @sub, @s1, @s2, $tmpvar);
if (!$ev{$function_name}) {
$tmp = $/;
$/ = "#---SEPARATOR---#";
($file, $num) = split(/-/, $funct{$function_name});
$file .= "_$pro_fileid" if $file >= 100;
open (FILE, "$admin_dir/source/src-board-subs-$file"); @file = ; close (FILE);
$sub = $file[$num];
$/ = $tmp;
@sub = split(/\n/, $sub); @s1 = grep(/^#REQ:/, @sub); @s2 = grep(!/^#/, @sub);
foreach $tempvar (@s1) {
$tempvar =~ m|^#REQ:(\w+)|; $o = $1; &ex($o);
}
$tempvar = join("\n", @s2); eval $tempvar;
$ev{$function_name} = $1;
}
if (scalar(@params) > 0) {
$tempvar = "\@result = &$function_name(\@params);"; eval $tempvar; return @result;
} else {
return 0;
}
}
sub lock {
local ($filename) = @_;
open (LOCK, "$admin_dir/locks.txt") || &error_message("File Locking Error", "Could not open file $admin_dir/locks.txt. Make sure $admin_dir/locks.txt exists and is world writable.");
@LOCK = ;
close (LOCK);
$time = time;
if (($ll) = grep(/\*/, @LOCK)) {
($timest) = split(/,/, $ll);
if ((time - $timest) <= 180) {
$es = $L{'FILELOCKREGEN'};
$t = (180 - (time - $timest));
$es =~ s/\%sec/$t/g;
&error_message("$L{'FILELOCKERROR'}", "$es");
} else {
@LOCK = grep(!/\*/, @LOCK);
}
}
if (!grep(/,$filename\s*$/, @LOCK)) {
open (LOCK, ">>$admin_dir/locks.txt") || &error_message("File Locking Error", "Could not append file $admin_dir/locks.txt. Make sure $admin_dir/locks.txt exists and is world writable.");
print LOCK "$time,$filename\n";
close (LOCK);
return 1;
} else {
$ctr = 0;
($line) = grep(/,$filename\s*$/, @LOCK);
($time_l) = split(/,/, $line);
if ($time > ($time_l + 5)) {
@LOCK = grep(!/,$filename\s*$/, @LOCK);
push (@LOCK, "$time,$filename\n");
open (LOCK, ">$admin_dir/locks.txt") || &error_message("File Locking Error", "Could not write file $admin_dir/locks.txt. Make sure $admin_dir/locks.txt exists and is world writable.");
print LOCK @LOCK;
close (LOCK);
return 1;
} else {
for ($ctr = 0; $ctr <= 100; $ctr++) {
open (LOCK, "$admin_dir/locks.txt");
@LOCK = ;
close (LOCK);
$time = time;
if (!grep(/,$filename\s*$/, @LOCK)) {
open (LOCK, ">>$admin_dir/locks.txt") || &error_message("File Locking Error", "Could not append file $admin_dir/locks.txt. Make sure $admin_dir/locks.txt exists and is world writable.");
print LOCK "$time,$filename\n";
close (LOCK);
return 1;
}
}
&error_message("$L{'FILELOCKERROR'}", "$L{FILEISLOCKED}", 0, 1);
}
}
}
sub unlock {
local ($filename) = @_;
open (LOCK, "$admin_dir/locks.txt") || &error_message("File Unlocking Error", "Could not open file $admin_dir/locks.txt. Make sure $admin_dir/locks.txt exists and is world writable.");
@LOCK = ;
close (LOCK);
@LOCK = grep(!/,$filename\s*$/, @LOCK) if $filename ne "*";
@LOCK = grep(!/\*/, @LOCK) if $filename eq "*";
if (scalar(@LOCK) == 0) {
push (@LOCK, "#\n");
}
open (LOCK, ">$admin_dir/locks.txt") || &error_message("File Unlocking Error", "Could not open file $admin_dir/locks.txt (System returned error: $!). Make sure $admin_dir/locks.txt exists and is world writable.");
print LOCK @LOCK;
close (LOCK);
}
sub parse_form {
undef %FORM;
if ($ENV{'CONTENT_LENGTH'} != 0) {
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///g;
$value =~ s/\r//g;
if ($FORM{$name} eq "") {
$FORM{$name} = $value;
} else {
$FORM{$name} .= ",$value";
}
}
}
$ENV{'QUERY_STRING'} =~ s/#(.*)$//;
if ($ENV{'QUERY_STRING'} ne "") {
$command = $ENV{'QUERY_STRING'};
@pairs = split(/&/, $command);
foreach $pair (@pairs) {
($name, $value) = split(/=/, $pair);
$value = &unescape($value);
$FORM{$name} = $value if $FORM{$name} eq "";
}
}
}
sub error_message {
local ($reason, $explanation, $flag, $noerr) = @_;
$excl_pt = $!;
&header;
&ex('printuntil', 1, 1, 0, "$reason") if !$flag;
print "\n";
print "$fs$reason\n";
print "
\n";
print "\n";
print "$explanation\n";
if ($excl_pt && !$noerr) {
print "\$!: $excl_pt
";
}
if ($@ && !$noerr) {
print "\$\@: $@
";
}
print "
\n";
print "\n";
print "
Please contact $contact if this problem persists.\n";
&ex('printuntil',3, 17, 0, "$reason") if !$flag;
exit(0);
}
sub extract {
local ($strin, $error_trapping) = @_;
local ($line, $filename, @file,$key);
undef %level_number;
$_ = "/$strin";
$secure = 0;
/.*\/(\d+)\/(\d+)\.$ext/;
$f1 = $1;
$f2 = $2;
&error_message('Undefined Error',"Undefined Error extracting file! Input file $_ is not a valid file!", 0, 1) if $f1 eq "";
$filename = "$message_dir/$f1/$f2.$ext"; $filename2 = "";
if (!-e "$message_dir/$f1") {
$filename2 = "$secdir/$f1/$f2.$ext";
$secure = 1;
}
$filename = $filename2 if $filename2 ne "";
if (!-e $filename) {
if (-e "$filename.NEW") {
&lock($filename);
if (!-e $filename && -e "$filename.NEW") {
if ($platform eq "NT" || $NT || $platform =~ m|NT|i) {
$code = 0;
} else {
$code = rename("$filename.NEW", "$filename");
}
if ($code != 1 || !-e $filename) {
open (FILE, "$filename.NEW");
@file = ;
close (FILE);
open (FILE, ">$filename");
print FILE @file;
close (FILE);
unlink ("$filename.NEW");
}
chmod (0666, "$filename");
}
&unlock($filename);
}
}
if (open (FILE_EXTRACT, $filename)) {
@file = ;
close (FILE_EXTRACT);
foreach $line (@file) {
$_ = $line;
$topic_name = $2 if //;
$topic_number = $1 if //;
$owner = $1 if //;
if (//) {
$key = $1;
$level_name{$key} = $3;
$level_number{$key} = $2;
}
$me_name = $2 if //;
$me_number = $1 if //;
$parent_number = $1 if //) {
$param = $1;
}
}
return 1;
} else {
&error_message('Undefined Error',"Undefined Error extracting file! $filename could not be opened!") if $error_trapping == 0;
$topic_name = "Corrupted Topic File";
$topic_number = $f1;
$owner = "unknown";
return 0;
}
}
sub JavaScript_prepare {
local ($str, $param) = @_;
$str =~ s//\[$1\]/g;
$str =~ s/<([^>]*)>//g;
$str =~ s/\n//g;
if ($param == 1) {
$str =~ s/([^\w ])/&makeord($1)/ge;
} else {
$str =~ s/(\d+);//g;
$str =~ s/'//g;
$str =~ s/"//g;
$str =~ s/"//g;
$str =~ s/&//g;
}
return $str;
}
sub makeord {
local ($o, $num) = @_;
if (ord($o) <= 126) {
$num = ord($o);
return "$num;";
} else {
return $o;
}
}
sub remove_links {
local ($string) = @_;
local ($str);
$str = $string;
$str =~ s/]*)>//g;
$str =~ s/<\/A>//g;
return $str;
}
sub read_cookie {
$buffer = $ENV{'HTTP_COOKIE'};
@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;
$COOKIE{$name} = $value;
}
}
sub escape {
local ($input) = @_;
local ($string);
$string = $input;
$string =~ s/([^\w ])/sprintf("%%%02lx", ord($1))/eg;
$string =~ tr/ /+/;
return $string;
}
sub unescape {
local ($input) = @_;
local ($string);
$string = $input;
$string =~ tr/+/ /;
$string =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
return $string;
}
sub remove_html {
local ($string, $flag) = @_;
local ($str);
$str = $string;
$str =~ s//\[$1\]/g;
$str =~ s/<[^>]*>//g;
$str =~ s/(\d+);//g if $flag == 0;
return $str;
}
sub seturl {
local ($targeturl) = @_;
if (!($nph_server)) {
print "Location: $targeturl\n\n";
exit(0);
} else {
&header;
print "Document Moved\n";
print "\n";
print "\n";
print "\n";
print "\n";
print "\n";
exit(0);
}
}
sub getfn {
local ($input) = @_;
local ($before, $after, $m, $o);
if ($input =~ m|(.*)/|) {
$before = "$1/";
$after = $';
} else {
$after = $input;
}
while ($after =~ m|(.)|g) {
$m = $1; $o = ord($m);
if ($m eq "." || $m =~ /\w/ || $m eq "-") {
$before .= $m;
} else {
$before .= "$o";
}
}
return $before;
}
sub print_cookie_string {
local ($username_in, $password_in, $password_to_crypt_in) = @_;
$username_in = "" if $ALREADY_SET_USERNAME;
$password_in = "" if $ALREADY_SET_PWIN;
$password_to_crypt_in = "" if $ALREADY_SET_PWCIN;
$store_cookies = 1 if $GLOBAL_OPTIONS{'cookies'};
if ($pro) {
&ex('pro_cookies', $username_in, $password_in, $password_to_crypt_in);
return 1;
} else {
return 0 if !$store_cookies;
print "Set-cookie: user$COOKIE_ID=$username_in; path=/\n" if $username_in;
$ALREADY_SET_USERNAME = 1 if $username_in;
print "Set-cookie: rpwd$COOKIE_ID=", "x" x $password_in, "; path=/\n" if $password_in;
$ALREADY_SET_PWIN = 1 if $password_in;
print "Set-cookie: cpwd$COOKIE_ID=" if $password_to_crypt_in;
print crypt($password_to_crypt_in, "cookie") if $password_to_crypt_in;
print "; path=/\n" if $password_to_crypt_in;
$ALREADY_SET_PWCIN = 1 if $password_to_crypt_in;
return 1;
}
}
sub get_page {
local ($topic, $page, $meta_override) = @_;
local ($head, $announce, $announce_src, $sublist, $about, $about_src, $message, $message_src, $flag, $color, $lm);
local ($save, @file);
if (-e "$html_dir/messages/$topic/$page.$ext") {
open (FILE, "$html_dir/messages/$topic/$page.$ext");
$secure = 0;
} else {
open (FILE, "$secdir/$topic/$page.$ext");
$secure = 1;
}
@file = ;
close (FILE);
@file_last_got = @file;
foreach $_ (@file) {
if (/^/) {
$flag = 1;
} elsif (/^/);
} elsif ($flag == 2 && m|^|) {
$flag = 0;
} elsif ($flag == 2) {
$about_src .= $_ if !/^-->/;
} elsif (/^/) {
$flag = 15;
} elsif (/^/);
} elsif ($flag == 16 && m|^|) {
$flag = 0;
} elsif ($flag == 16) {
$announce_src .= $_ if !/^-->/;
} elsif (m||) {
$flag = 3; $save = $1;
$message .= $_;
} elsif (m||) {
$flag = 0;
$message .= $_;
} elsif ($flag == 3) {
$message .= $_;
} elsif (/^/) {
$flag = 0;
} elsif ($flag == 4) {
$message_src .= $_;
} elsif (m|^|) {
$meta_description = $1 if !$meta_override;
} elsif (m|^|) {
$meta_keywords = $1 if !$meta_override;
} elsif (m|^|) {
$meta_robots = $1 if !$meta_override;
}
}
if ($color eq "") {
$color = "ffffff\t000000\t0000ff\t800080\tff0000\t\t2\tVerdana,Arial,Helvetica";
}
return ($head, $color, $lm, $announce, $announce_src, $sublist, $about, $about_src, $message, $message_src);
}
sub set_page {
local ($topic, $page, $head, $color, $timestr, $announcement_variable, $announcement_source_variable, $subtopic_variable, $about_variable, $about_source_variable, $message_variable, $message_source_variable, $templatefile, $addfile, $timesaver) = @_;
return 0 if $page eq "";
local (@tfile, $line, $param, $owner, $levelj, $navline, $navbar, $str, $file, @file);
$message_variable = &add_message_icons($message_variable);
if ($templatefile) {
@tfile = split(/\n/, $templatefile);
foreach $line (@tfile) {
$line .= "\n";
}
@tfile = grep(/\S/, @tfile);
} else {
if (open (TFILE, "$html_dir/messages/$topic/newpage.conf")) {
@tfile = ;
close (TFILE);
} elsif (open (TFILE, "$secdir/$topic/newpage.conf")) {
@tfile = ;
close (TFILE);
} else {
open (TFILE, "$admin_dir/newpage.conf");
@tfile = ;
close (TFILE);
}
}
if (!(grep(//, @tfile))) {
&error_message("Save Error", "The newpage.conf template has been corrupted; unable to save your change", 0, 1);
}
if (!(grep(/\$subtopic_variable/, @tfile)) || !(grep(/\$about_variable/, @tfile)) || !(grep(/\$message_variable/, @tfile)) || !(grep(/\$message_source_variable/, @tfile)) || !(grep(/\$about_source_variable/, @tfile)) || !(grep(/\$head/, @tfile))) {
&error_message("Save Error", "The newpage.conf template has been corrupted; unable to save your change", 0, 1);
}
local ($bgcolor, $text, $link, $vlink, $alink, $image, $size, $face) = split(/\t/, $color);
local (%level_number, %level_name, $topic_number, $topic_name, $me_number, $me_name);
foreach $line (split(/\n/, $head)) {
if ($line =~ m||) {
($topic_number, $topic_name) = ($1, $2);
} elsif ($line =~ m||) {
$level_number{$1} = $2; $level_name{$1} = $3;
} elsif ($line =~ m||) {
$me_number = $1; $me_name = $2;
} elsif ($line =~ m||) {
$param = $1;
} elsif ($line =~ m||) {
$owner = $1;
}
}
$navline = "$title: ";
if ($topic_number != $me_number) {
$levelj = &JavaScript_prepare($topic_name);
$navline .= "";
$navline .= "$topic_name: ";
} else {
$navline .= "$topic_name";
}
foreach $line (sort by_number keys(%level_number)) {
if ($level_number{$line} != $me_number) {
$levelj = &JavaScript_prepare($level_name{$line});
$navline .= "";
$navline .= "$level_name{$line}:\n";
} else {
$navline .= "$level_name{$line}";
}
}
$str = &JavaScript_prepare($navline);
$navbar = $navline;
local (@users, @addfile, $line_2, @valid, $privpub);
if ($addfile) {
@addfile = split(/\n/, $addfile);
foreach $line (@addfile) {
$line .= "\n";
if ($line =~ m||) {
$line .= "\n";
}
}
@addfile = grep(/\S/, @addfile);
} else {
open (POST, "$admin_dir/posting.txt"); @post = ; close (POST);
($line) = grep(/^$topic:/, @post);
($t, $ip) = split(/:/, $line);
if ($ip eq "") {
$privpub = "private";
} else {
$privpub = "public";
}
open (POST, "$admin_dir/postoptions.txt"); @post = ; close (POST);
($line) = grep(/^$topic:/, @post);
($t, $an) = split(/:/, $line);
$anflag = $an;
$anflag = 1 if ($GLOBAL_OPTIONS{'anonymous'} == 0 && $GLOBAL_OPTIONS{'options_used'} == 1);
if (open(FILExx, "$message_dir/$topic/addmessage.conf")) {
@addfile = ;
close (FILExx);
} elsif (open(FILExx, "$secdir/$topic/addmessage.conf")) {
@addfile = ;
close (FILExx);
} elsif ($line =~ m|::::\s*$| && !-e "$message_dir/$topic/addmessage.conf" && !-e "$secdir/$topic/addmessage.conf") {
$l = $L{BPPOSTINGDISABLEDDESCR};
$l =~ s|\%aopen||g;
$l =~ s|\%aclose||g;
@addfile = ("
");
} else {
open (FILExx, "$admin_dir/addmessage-$privpub.conf");
@addfile = ;
close (FILExx);
}
foreach $line_2 (@addfile) {
if ($line_2 =~ m||) {
$line_2 .= "\n";
}
$line_2 =~ s///g;
$line_2 =~ s//$script_url\/board-post.$cgi_extension/g;
}
@addfile = grep(!/^/, @addfile) if $anflag;
}
undef @file;
local ($flag, $navflag, $flag2, $pagetitle, @array);
@array = split(/\n/, $subtopic_variable); @array = grep(/\S/, @array); $subtopic_variable = join("\n", @array);
@array = split(/\n/, $about_variable); @array = grep(/\S/, @array); $about_variable = join("\n", @array);
@array = split(/\n/, $about_source_variable); @array = grep(/\S/, @array); $about_source_variable = join("\n", @array);
@array = split(/\n/, $message_variable); @array = grep(/\S/, @array); $message_variable = join("\n", @array);
@array = split(/\n/, $message_source_variable); @array = grep(/\S/, @array); $message_source_variable = join("\n", @array);
$pagetitle = $me_name;
$flag = 0; $navflag = 0; $flag2 = 0;
foreach $line (@tfile) {
if ($line =~ //) {
$flag = 1;
} elsif ($flag == 1) {
if ($line =~ m|\n\n$navbar\n\n\n");
} elsif ($navflag == 1) {
$navflag = 0 if $line =~ m||) {
push (@file, "\n") if $param =~ m|Sublist|;
} elsif ($line =~ m||) {
push (@file, "-->\n\n") if $param !~ m|Sublist|;
push (@file, "\n") if $param =~ m|Sublist|;
} elsif ($line =~ m||) {
push (@file, "\n") if $param =~ m|Create|;
} elsif ($line =~ m||) {
push (@file, "-->\n\n") if $param !~ m|Create|;
push (@file, "\n") if $param =~ m|Create|;
} elsif ($line =~ m||) {
push (@file, "\n") if $param =~ m|About|;
} elsif ($line =~ m|\n|) {
push (@file, "\n") if $param =~ m|Messages|;
} elsif ($line =~ m||) {
push (@file, "-->\n\n") if $param !~ m|Messages|;
push (@file, "\n") if $param =~ m|Messages|;
} elsif ($line =~ m||) {
push (@file, "\n") if $param =~ m|Add|;
} elsif ($line =~ m||) {
push (@file, "-->\n\n") if $param !~ m|Add|;
push (@file, "\n") if $param =~ m|Add|;
} elsif ($line =~ m||) {
push (@file, "\n") if $param =~ m|Announcement|;
} elsif ($line =~ m|\n