# FILE: src-board-subs-18
# Rarely used functions
#-------------------------------------------------------------------------------
# DISCUS VERSION 3.10 COPYRIGHT NOTICE
#
# Discus 3.10 is copyright (c) 2000 by DiscusWare, LLC, all rights reserved.
# The use of Discus is governed by the Discus License Agreement which is
# available from the Discus WWW site at:
# http://www.discusware.com/discus/license
#
# Pursuant to the Discus License Agreement, this copyright notice may not be
# removed or altered in any way.
#-------------------------------------------------------------------------------
#---SEPARATOR---#
sub register_discus {
my ($parameter) = @_;
&header;
print 'Password Changed' if $parameter != 2;
print 'Board Upgraded' if $parameter == 2;
print "\n";
print "$fsPassword Set" if $parameter != 2;
print "$fsBoard Upgraded" if $parameter == 2;
if ($parameter != 2) {
print "\n
\nCongratulations, your superuser password was successfully set.\n";
print "At this time, you need to "Register" the Discus\n";
print "program by clicking on "Register Now!" below.
\n";
} else {
print "\n
\nCongratulations, your Discus board was successfully upgraded.\n";
print "At this time, we ask that you register your upgrade by clicking on\n";
print ""Register Now" below.
\n";
}
print "
\n\n";
exit(0);
}
#---SEPARATOR---#
sub perl_warn {
my ($username) = @_;
$perl_v = $];
&header;
print "Perl Incompatibility Warning\n";
print "\n";
print "$fsPerl Incompatibility Warning\n";
print "
\n";
print "This warning message appears when the CGI scripts are being executed by a version\n";
print "of Perl less than version 5. Beginning with version 3.10 of Discus, scripts must\n";
print "be executed using Perl version 5. Because this discussion board is running an older,\n";
print "out-of-date version of Perl, some of the board functions may not work properly.\n";
print "The specified Perl interpreter, ";
open (FILE, "./board-admin-menuonly.$cgi_extension"); @file = ; close (FILE);
$perl = $file[0]; $perl =~ s/^#!//; $perl =~ s/\s+$//;
print $perl;
print ", is reported to be Perl version $perl_v.
\n";
print "To address this problem, the board administrator must follow these instructions\n";
print "to cause Perl 5 to execute the Discus scripts:
\n";
print " http://www.discusware.com/discus/install/perl5.html\n";
print "
\n";
print "To begin using administration, click on any of the links in the left frame.\n";
print "\n";
exit(0);
}
#---SEPARATOR---#
sub upgrade_file_structure {
&log_error("src-board-subs-18", "upgrade_file_structure", "Upgrade file structure invoked!");
# This upgrades file structure from version 2.50 to 3.00
# This affects users.txt, passwd.txt, posting.txt, security.txt, queue.txt,
# postoptions.txt
# First, make sure the board hasn't already been updated with this file structure
open (USERS, "$admin_dir/users.txt"); @users = ; close (USERS);
return 1 if grep(/^UPDATED300:/, @users);
# If you have data in your posting.txt file, then you're already running
# version 3.0! The thing above didn't work since you started with version 3.0.
if (open(POSTING, "$admin_dir/posting.txt")) {
@posting = ;
close (POSTING);
@p = grep(/^(\d+):/, @posting);
if (scalar(@p)) {
&lock("upgrade_file_structure", "$admin_dir/users.txt");
open (USERS, ">>$admin_dir/users.txt");
print USERS "UPDATED300:*:::0:::\n";
close (USERS);
&unlock("upgrade_file_structure", "$admin_dir/users.txt");
return 1;
}
}
# Determine the topic structure of the board
undef @topics; undef %group;
open (TOP, "$message_dir/$board_topics_file"); @top = ; close (TOP);
@top = grep(/^/, @top);
foreach $line (@top) {
$line =~ m||;
$t = $1;
&extract("//$t/$t.$ext");
push (@topics, $t);
$group{$t} = $owner;
}
# Determine properties of groups and update e-mail notification
undef %public; undef %moder; undef %user; undef %disable;
undef %anon; undef %stamp;
&lock("upgrade_file_structure", "$admin_dir/users.txt");
open (USERS, "$admin_dir/users.txt"); @users = ; close (USERS);
foreach $line (@users) {
chop $line if $line =~ m|\n$|;
($user, $pass, $email, $full, $edit, $notify, $last, $group) = split(/:/, $line);
if (($pass eq "*" || $pass eq "") && $full =~ m|\w+ USER - DO NOT|) {
$public{$group} = 1 if $user eq "PUBLIC";
$moder{$group} = 1 if $user eq "MODERATORS";
$user{$group} = 1 if $user eq "USERS";
$disable{$group} = 1 if $user eq "DISABLE";
$anon{$group} = 1 if $user eq "DISABLEANON";
$stamp{$group} = 1 if $user eq "DISABLESTAMP";
$line = "";
} else {
undef @notify;
if ($notify == 2 || $notify == 3) {
foreach $topic (@topics) {
if ($group{$topic} eq $group) {
push (@notify, $topic);
}
}
}
if ($notify == 1 || $notify == 3) {
push (@notify, 0);
}
$notify = join(",", @notify);
$line = join(":", $user, $pass, $email, $full, $edit, $notify, $last, "$group\n");
}
}
@users = grep(/\S/, @users);
push (@users, "UPDATED300:*:::0:::\n");
open (USERS, ">$admin_dir/users.txt"); print USERS @users; close (USERS);
&unlock("upgrade_file_structure", "$admin_dir/users.txt");
# Update e-mail notification in passwd.txt file
&lock("upgrade_file_structure", "$admin_dir/passwd.txt");
&lock("upgrade_file_structure", "$admin_dir/groups.txt");
undef %mods;
open (PASSWD, "$admin_dir/passwd.txt"); @passwd = ; close (PASSWD);
open (GROUPS, "$admin_dir/groups.txt"); @groups = ; close (GROUPS);
&unlock("upgrade_file_structure", "$admin_dir/groups.txt");
foreach $line (@groups) {
chop ($line) if $line =~ m|\n$|;
($groupname, $mods) = split(/:/, $line);
$mods{$groupname} = $mods;
}
foreach $line (@passwd) {
chop $line if $line =~ m|\n$|;
($user, $pass, $email, $full, $edit, $notify, $last) = split(/:/, $line);
undef @notify;
if ($notify == 2 || $notify == 3) {
foreach $topic (@topics) {
$g = $group{$topic};
@ms = split(/,/, $mods{$g});
if (grep(/^$user$/, @ms)) {
push (@notify, $topic);
}
}
}
if ($notify == 1 || $notify == 3) {
push (@notify, 0);
}
$notify = join(",", @notify);
$line = join(":", $user, $pass, $email, $full, $edit, $notify, "$last\n");
}
open (PASSWD, ">$admin_dir/passwd.txt"); print PASSWD @passwd; close (PASSWD);
&unlock("upgrade_file_structure", "$admin_dir/passwd.txt");
# Write out the posting.txt and security.txt files with normal settings
&lock("upgrade_file_structure", "$admin_dir/posting.txt");
open (POSTING, ">$admin_dir/posting.txt");
foreach $topic (@topics) {
$line_out = "$topic:";
$g = $group{$topic};
$line_out .= "~" if ($public{$g} && !$disable{$g});
$line_out .= ":";
$line_out .= "~" if ($moder{$g} && !$disable{$g});
$line_out .= "$g" if ($moder{$g} == 0 && !$disable{$g});
$line_out .= ":";
$line_out .= "~" if ($user{$g} && !$disable{$g});
$line_out .= "$g" if ($user{$g} == 0 && !$disable{$g});
$line_out .= ":\n";
print POSTING $line_out;
}
close (POSTING);
&unlock("upgrade_file_structure", "$admin_dir/posting.txt");
&lock("upgrade_file_structure", "$admin_dir/security.txt");
open (SECURITY, ">$admin_dir/security.txt");
foreach $topic (@topics) {
print SECURITY "$topic:~:::\n";
}
close (SECURITY);
&unlock("upgrade_file_structure", "$admin_dir/security.txt");
# Write out the postoptions.txt file
&lock("upgrade_file_structure", ">$admin_dir/postoptions.txt");
open (POSTOPTIONS, ">$admin_dir/postoptions.txt");
foreach $topic (@topics) {
$g = $group{$topic};
$line_out = "$topic:";
$line_out .= "1" if $anon{$g};
$line_out .= ":";
$line_out .= "1" if $stamp{$g};
$line_out .= ":";
$line_out .= "1" if $stamp{$g};
$line_out .= "\n";
print POSTOPTIONS $line_out;
}
close (POSTOPTIONS);
&unlock("upgrade_file_structure", "$admin_dir/postoptions.txt");
# Write out the queue.txt file
&lock("upgrade_file_structure", ">$admin_dir/queue.txt");
open (QUEUE, ">$admin_dir/queue.txt");
foreach $topic (@topics) {
print QUEUE "$topic:0:0:0:0\n";
}
close (QUEUE);
&unlock("upgrade_file_structure", ">$admin_dir/queue.txt");
}
#---SEPARATOR---#
sub cuss_save {
my ($words) = @_;
&lock("cuss_save", "$admin_dir/cuss.txt");
@words = split(/\n/, $words);
@words = grep(/\S/, @words);
undef @cuss;
foreach $word (@words) {
$word =~ tr/b-zaB-ZA/a-zA-Z/;
$word =~ s/^\s+//; $word =~ s/\s+$//;
push (@cuss, "!$word\n");
}
open (CUSS, ">$admin_dir/cuss.txt"); print CUSS @cuss; close (CUSS);
&unlock("cuss_save", "$admin_dir/cuss.txt");
}
#---SEPARATOR---#
sub search_clear {
my ($topic) = @_;
if ($topic =~ m|^\d+$|) {
open (MSG, ">$admin_dir/msg_index/$topic-search.txt");
close (MSG);
} else {
open (TOPIC, "$message_dir/$board_topics_file");
@topic = ;
close (TOPIC);
foreach $line (@topic) {
if ($line =~ m||) {
$file = $1;
open (MSG, ">$admin_dir/msg_index/$file-search.txt");
close (MSG);
}
}
}
}
#---SEPARATOR---#
sub bug_report {
&header;
print "DiscusWare, LLC Support System\n";
print "$fs";
print "DiscusWare, LLC Support System
\n";
print "The Discus Support System is a free service of DiscusWare, LLC that provides instant feedback\n";
print "to our customers and Discus board users that will help them to resolve problems experienced in\n";
print "the use of the Discus discussion board product.\n";
print "\n";
print "DiscusWare, LLC offers technical support for our products through this system and the Discus\n";
print "technical support forum. If this error message indicates a technical problem with your site,\n";
print "we will happily assist you in resolving it. However, for a faster response, we suggest that you\n";
print "attempt to resolve this problem yourself by following instructions (if available) regarding this error.\n";
print "
\n";
print "DiscusWare, LLC cannot help you resolve any issues specific to this board, such as a\n";
print "forgotten password, application for a new account, e-mail notification difficulty, etc.\n";
print "Any such reports should be addressed to the contact person for this board, $contact.\n";
print "
DiscusWare, LLC does not necessarily maintain this site. Any questions or comments\n";
print "that do not directly concern the technical operation of this board should be addressed\n";
print "to the contact person listed above. DiscusWare, LLC will ignore (without response) any\n";
print "such comments we receive. We wrote the software but we are probably not in charge of this\n";
print "particular implementation of the software.\n";
print "
\n";
print "\n";
exit(0);
}
undef %upopt;
@upopt = split(/,/, $FORM{'upopt'});
foreach $x (@upopt) {
$upopt{$x} = 1;
}
if ($FORM{'rrrrr'} == 1) {
&seturl("$cgiurl?username=$superuser&action=upgrade3_00&rrrrr=6&upopt=$FORM{'upopt'}") if $upopt{'1'} == 0;
®enerate_board('Upgrade is regenerating your board from templates (step 3 of 4)', "$cgiurl?username=$superuser&action=upgrade3_00&rrrrr=1&upopt=$FORM{'upopt'}", "$cgiurl?username=$superuser&action=upgrade3_00&rrrrr=6&upopt=$FORM{'upopt'}", "Regenerating Board");
}
if ($FORM{'rrrrr'} == 2) {
&seturl("$cgiurl?username=$superuser&action=upgrade3_00&rrrrr=1&upopt=$FORM{'upopt'}") if $upopt{'2'} == 0;
&rebuild_tree('Upgrade is indexing your board (step 2 of 4)', "$cgiurl?username=$superuser&action=upgrade3_00&rrrrr=2&upopt=$FORM{'upopt'}", "$cgiurl?username=$superuser&action=upgrade3_00&rrrrr=1&upopt=$FORM{'upopt'}");
}
if ($FORM{'rrrrr'} == 3) {
&seturl("$cgiurl?username=$superuser&action=upgrade3_00&rrrrr=2&upopt=$FORM{'upopt'}") if $upopt{'3'} == 0;
&upgrade_filestructure('Upgrade is upgrading file structure (step 1 of 4)', "$cgiurl?username=$superuser&action=upgrade3_00&rrrrr=3&upopt=$FORM{'upopt'}", "$cgiurl?username=$superuser&action=upgrade3_00&rrrrr=2&upopt=$FORM{'upopt'}", "Upgrading File Structure");
}
if ($FORM{'rrrrr'} == 4) {
&seturl("$cgiurl?username=$superuser&action=upgrade3_00&rrrrr=3&upopt=$FORM{'upopt'}") if $upopt{'4'} == 0;
&rebuild_logs('Upgrade is rebuilding logs', "$cgiurl?username=$superuser&action=upgrade3_00&rrrrr=4&upopt=$FORM{'upopt'}", "$cgiurl?username=$superuser&action=upgrade3_00&rrrrr=3&upopt=$FORM{'upopt'}");
}
if ($FORM{'rrrrr'} == 5) {
&upgrade_file_structure;
&seturl("$cgiurl?username=$superuser&action=upgrade3_00&rrrrr=4&upopt=$FORM{'upopt'}");
}
if ($FORM{'rrrrr'} == 6) {
&seturl("$cgiurl?username=$superuser&action=upgrade3_00&rrrrr=7&upopt=$FORM{'upopt'}") if $upopt{'6'} == 0;
®enerate_board('Upgrade is preparing your search engine (step 4 of 4)', "$cgiurl?username=$superuser&action=upgrade3_00&rrrrr=6&upopt=$FORM{'upopt'}", "$cgiurl?username=$superuser&action=upgrade3_00&rrrrr=7&upopt=$FORM{'upopt'}", "", 6, "", "", "", "Building Search Engine Index");
}
if ($FORM{'rrrrr'} == 7) {
&change_board_colors("*");
$dt = &get_date_time("long");
if (open (UPGRADE, ">>$admin_dir/upgrade.txt")) {
print UPGRADE "------------------------------------------------\n";
print UPGRADE "Upgraded from previous version to Discus 3.10...\n";
print UPGRADE $dt, "\n";
print UPGRADE "Complete: version 3.10\n";
close (UPGRADE);
} else {
&header;
print "Upgrade Successful
\n";
print "Discus could not write this upgrade to the\n";
print "upgrade.txt file in your Discus administration directory.\n";
print "Reason: $!
\n";
print "To have Discus recognize the upgrade and allow your moderators\n";
print "in, edit the "upgrade.txt" file and add the following\n";
print "line:
\n";
print "
Complete: version 3.10
\n";
print "Then, log in again.
\n";
exit(0);
}
®ister_discus(2);
exit(0);
}
}
#---SEPARATOR---#
sub inverse_get_date_time {
my ($format, $targettime) = @_;
my ($pattern, $ls, $count, $month, %var, $i, $x);
if ($INVERSE_failed) {
return 0;
}
if ($PREV_FORMAT ne $format) {
undef @corres;
}
eval 'use Time::Local;';
if ($@) {
$INVERSE_failed = 1;
return 0;
}
$PREV_FORMAT = $format;
$ls = $L{LONGDATE} if $format eq "long";
$ls = $L{SHORTDATE} if $format eq "short";
if ($format eq "shorter") {
if ($L{SHORTERDATE} ne "") {
$ls = $L{SHORTERDATE};
} else {
$ls = $L{SHORTDATE};
}
}
if ($format eq "message") {
if ($L{MESSAGEDATE} ne "") {
$ls = $L{MESSAGEDATE};
} else {
$ls = $L{LONGDATE};
}
}
$ls = $L{REALSHORTDATE} if $format eq "realshort";
$ls = $L{DATEONLY} if $format eq "dateonly";
$pattern = $ls;
$pattern =~ s/\%//g;
$pattern = quotemeta($pattern);
$pattern =~ s/\\/\%/g;
$pattern =~ s/\%weekday/\(\\S\+\)/g;
$pattern =~ s/\%month/\(\\S\+\)/g;
$pattern =~ s/\%day/\(\\d\+\)/g;
$pattern =~ s/\%year/\(\\d\+\)/g;
$pattern =~ s/\%hour/\(\\d\+\)/g;
$pattern =~ s/\%minute/\(\\d\+\)/g;
$pattern =~ s/\%ampm/\(\\S\+\)/g;
$pattern =~ s/\%nmonth/\(\\d\+\)/g;
if (scalar(@corres) == 0) {
$count = 0;
while ($ls =~ m|\%(\w+)|g) {
$count += 1;
$corres[$count] = $1;
}
$count = 0; undef %month;
foreach $month (@MONTH) {
$count += 1;
$month{$month} = $count;
}
}
if ($targettime =~ m|$pattern|o) {
undef %var;
for ($i = 1; $i <= scalar(@corres); $i++) {
$var{$corres[$i]} = $$i;
}
if ($var{nmonth} eq "") {
$m = $var{month};
$var{nmonth} = $month{$m};
}
return 0 if ($var{nmonth} < 0 || $var{nmonth} > 12);
return 0 if ($var{day} < 0 || $var{day} > 31);
return 0 if $var{year} == 0;
$var{hour} = 0 if ($var{hour} == 12 && $var{ampm} eq $L{AM});
$var{hour} += 12 if ($var{hour} < 12 && $var{ampm} eq $L{PM});
return 0 if $var{nmonth} == 0;
$x = timelocal($var{sec},$var{minute},$var{hour},$var{day},$var{nmonth}-1,$var{year});
$x += ($GLOBAL_OPTIONS{'timezone'}*3600);
return $x;
}
return 0;
}
#---SEPARATOR---#
#REQ:change_private_and_public
#REQ:posting_options
sub access_edit_simple {
my ($topic, $file, $public, $modgroup, $usergroup, $modall, $userall, $owner, $killit, $coded) = @_;
&lock("access_edit_simple", "$admin_dir/$file.txt");
open (FILE, "$admin_dir/$file.txt") || &error_message("File open error", "Could not open $admin_dir/$file.txt!");
@file = ; close (FILE);
@file = grep(/\S/, @file);
if (grep(/^$topic:/, @file)) {
($line) = grep(/^$topic:/, @file);
@file = grep(!/^$topic:/, @file);
($tn, $ip, $usr, $mod, $pas) = split(/:/, $line);
} else {
$line = "$topic::::"; $ip = ""; $usr = ""; $mod = ""; $pas = "\n";
}
@ip = split(/,/, $ip);
@mod = split(/,/, $mod);
@usr = split(/,/, $usr);
$was_public = 0;
$was_public = 1 if $ip ne "";
$was_public = 2 if $line =~ /::::\s*$/;
@ip = grep(!/^~$/, @ip); push (@ip, "~") if $public; $ip = join(",", @ip);
@mod = grep(!/^$owner$/, @mod); push (@mod, $owner) if ($modgroup && !$modall); $mod = join(",", @mod);
@usr = grep(!/^$owner$/, @usr); push (@usr, $owner) if ($usergroup && !$userall); $usr = join(",", @usr);
@mod = grep(!/^~$/, @mod); push (@mod, "~") if $modall; $mod = join(",", @mod);
@usr = grep(!/^~$/, @usr); push (@usr, "~") if $userall; $usr = join(",", @usr);
$line = join(":", $topic, $ip, $usr, $mod, $pas);
push (@file, $line) if $killit ne "Disable All Posting";
push (@file, "$topic:" . ":::\n") if $killit eq "Disable All Posting";
$was_public = 2 if $killit eq "Disable";
open (FILE, ">$admin_dir/$file.txt") || &error_message("File write error", "Could not write $admin_dir/$file.txt because: $!!");
print FILE @file;
close (FILE);
&unlock("access_edit_simple", "$admin_dir/$file.txt");
$code = &posting_options($FORM{'topic'}, $FORM{'anondisable'}, $FORM{'stampdisable'}, $FORM{'emaildisable'});
if ($file eq "posting") {
$was_public = 2 if $code;
if (($was_public == 1 || $was_public == 2 || $MUST_REGENERATE_PAGES) && !$public && !-e "$secdir/$topic/addmessage.conf" && !-e "$message_dir/$topic/addmessage.conf") {
($bgcolor, $text, $link, $vlink, $alink, $face, $size, $image) = &extract_colorsonly;
if ($killit eq "Disable") {
$ac = $L{BPPOSTINGDISABLEDDESCR};
$ac =~ s#\%aopen##g;
$ac =~ s#\%aclose##g;
$L{BPPOSTINGDISABLEDDESCR} = $ac;
$af = "
| $L{BPPOSTINGDISABLEDDESCR} |
";
} else {
open (ADDFILE, "$admin_dir/addmessage-private.conf"); @af = ; close (ADDFILE);
@af = grep(!/^/, @af) if $MUST_REGENERATE_PAGES == 1;
$af = join("", @af);
$af =~ s///g;
$af =~ s//$script_url\/board-post.$cgi_extension/g;
}
&change_private_and_public($topic, $topic, $af, $was_public);
} elsif (($was_public == 0 || $was_public == 2 || $MUST_REGENERATE_PAGES) && $public && !-e "$secdir/$topic/addmessage.conf" && !-e "$message_dir/$topic/addmessage.conf") {
($bgcolor, $text, $link, $vlink, $alink, $face, $size, $image) = &extract_colorsonly;
if ($killit eq "Disable") {
$ac = $L{BPPOSTINGDISABLEDDESCR};
$ac =~ s#\%aopen##g;
$ac =~ s#\%aclose##g;
$L{BPPOSTINGDISABLEDDESCR} = $ac;
$af = "
| $L{BPPOSTINGDISABLEDDESCR} |
";
} else {
open (ADDFILE, "$admin_dir/addmessage-public.conf"); @af = ; close (ADDFILE);
@af = grep(!/^/, @af) if $MUST_REGENERATE_PAGES == 1;
$af = join("", @af);
$af =~ s///g;
$af =~ s//$script_url\/board-post.$cgi_extension/g;
}
&change_private_and_public($topic, $topic, $af, $was_public);
}
}
}
#---SEPARATOR---#
#REQ:regenerate_board
sub change_private_and_public {
my ($topic_number, $me_number, $text, $was_public) = @_;
my (@post, $pl, $doneurl);
open (POST, "$admin_dir/posting.txt"); @post = ; close (POST);
($pl) = grep(/^$topic_number:/, @post); @pl = split(/:/, $pl);
if ((($pl[1] eq "" && $was_public) || ($pl[1] ne "" && !$was_public)) || $was_public == 2) {
$doneurl = "$cgiurlm?username=$FORM{'username'}&action=access_mgr_2&HTTP_REFERER=//$topic_number/$topic_number.$ext";
®enerate_board("Updating "Add a Message" Boxes", "$cgiurl?action=addmsg&username=$FORM{'username'}&topic=$topic_number", $doneurl, $topic_number, 5);
}
}
1;
# END - FILE IS CORRECTLY UPLOADED #