#
# BBMAN - The BBMATIC BBS FOR THE WEB Manager
#
# Filename: bbman.pl
# Copyright: 1997,1998,1999 by Joe DePasquale
# Last revised: August 1, 1999
# E-Mail: crypt@getcruising.com
# Website: http://www.GetCruising.com
#
###########################################################################
#
# This script and accompanying files may be distributed freely
# and modified, provided this header with my name, E-Mail address and
# this notice remain intact. Ownership rights remain with me. You may
# not sell this script without my approval.
#
# This script comes with no guarantee or warranty except for my good
# intentions. By using this code you agree to indemnify me from any
# liability that might arise from it's use.
#
# There is no technical support for this script, neither am I a
# professional programmer. Refer to 'HELPME.TXT' for further guidance.
#
###########################################################################
# Setup stuff
sub bbman {
print qq|<html>\n<head><title>$headTitle</title></head>\n|;
print qq|$bodyTag\n$bodyTitle\n<p>\n|;
&passtest ($BBMPWD);
########################################################################
# Case: Delete and archive posts by age
if ($Form{'deletebyage'})
{
if ($Form{'minmonths'})
{ $minSpan = $Form{'minmonths'} *100;
if ($dateStamp %10000 < $minSpan +100)
{ $minDate = $dateStamp -$minSpan -8800;
} else
{ $minDate = $dateStamp -$minSpan;
}
} else
{ &endMan ("Must select minimum months of inactivity 1-12");
}
open (LOCK,">$BBMFLK") || &endMan ("Write: $BBMFLK");
if (!flock (LOCK,2)) { &endMan ("Lock: $BBMFLK"); }
open (BBM,"+<$BBMDAT") || &endMan ("Read\/Write: $BBMDAT");
flock (BBM,2); seek (BBM,0,0);
$startSize = @bbmFile = <BBM>;
$lineNbr =0;
$subjCnt =0; $fileCnt =0;
while ($lineNbr <=$#bbmFile)
{ $postCnt =0; $lastDate =0;
do
{ @fields = split (/\|/,$bbmFile[$lineNbr+$postCnt]);
if ($postCnt ==0) { $subjNbr = $fields[0]; }
$endFlag = 'Y';
if ($fields[0] == $subjNbr)
{ ($mm,$dd,$yy) = split (/\//,$fields[5]);
$postDate = $yy *10000 + $mm *100 + $dd;
if ($postDate > $lastDate) { $lastDate = $postDate; }
$postCnt++; $endFlag = 'N';
}
} until ($endFlag eq 'Y');
if ($lastDate < $minDate)
{ push (@purgeList,$subjNbr);
$SUBJFILE = "$scriptDir/bbm$subjNbr.txt";
undef @subjFile;
if (-e $SUBJFILE)
{ open (SUBJECT,"<$SUBJFILE") || &endMan ("Read: $SUBJFILE");
flock (SUBJECT,1); seek (SUBJECT,0,0);
@subjFile = <SUBJECT>;
close (SUBJECT);
}
$x =0;
for $y ($lineNbr..$lineNbr+$postCnt-1)
{
$oldLine = $bbmFile[$y];
if ($subjFile[$x])
{ $oldLine =~ s/\n$//;
$oldLine .= "$subjFile[$x]";
}
push (@oldFile,$oldLine);
$x++;
}
splice (@bbmFile,$lineNbr,$postCnt);
$subjCnt++;
} else
{ $lineNbr = $lineNbr+$postCnt;
}
}
if ($subjCnt > 0)
{
# Add pastdate postings to the archive file
open (OLD,"+<$BBMOLD") || &endMan ("Read\/Write: $BBMOLD");
flock (OLD,2); seek (OLD,0,0);
@unsorted = <OLD>;
push (@unsorted,@oldFile);
for $x (0..$#unsorted)
{ @index = split (/\|/,$unsorted[$x],3);
$OldFile{$x} = $index[0]+($index[1]/10000);
}
seek (OLD,0,0);
foreach $index (sort {$OldFile{$b} <=> $OldFile{$a}} keys %OldFile)
{ print OLD "$unsorted[$index]";
}
truncate (OLD,tell(OLD)); close (OLD);
# Write the new bbmdata file
seek (BBM,0,0);
print (BBM @bbmFile);
truncate (BBM,tell(BBM));
# Delete pastdate subject files
foreach $subjNbr (@purgeList)
{ $SUBJFILE = "$scriptDir/bbm$subjNbr.txt";
{ if (-e $SUBJFILE)
{ unlink $SUBJFILE;
$fileCnt++;
}
}
}
}
close (BBM);
close (LOCK);
$lineCnt = @oldFile;
$endSize = @bbmFile;
print qq|<font color="#0000FF">MAINTENANCE COMPLETED.</font>\n<p>\n|;
print qq|<b>Summary of records processed</b>:<br>\nBBMDAT File: "$BBMDAT"<br>\n|;
print qq| $subjCnt subjects were purged totaling $lineCnt lines.<br>\n|;
print qq| Originally $startSize lines, now $endSize lines in file.<br>\n|;
print qq|$fileCnt related SUBJECT FILES were deleted from "$scriptDir/".\n<p>\n|;
&manager ($Form{'minmonths'});
&footer;
} # end deletebyage
######################################################################
# CASE: Print list of all posts
elsif ($Form{'listbynumber'})
{
open (BBM,"<$BBMDAT") || &endMan ("Read: $BBMDAT");
flock (BBM,1); seek (BBM,0,0);
@bbmFile = <BBM>;
close (BBM);
print qq|<form action="$scriptUrl" method=POST>\n|;
print qq|<input type=hidden name=password value="$Form{'password'}">\n|;
print qq|<input type=hidden name=manager value=1>\n|;
print qq|<input type=hidden name=script value="$script">\n|;
print qq|<b>Select Subjects and/or Comments to be deleted:</b>\n<p>\n|;
print qq|<font color="#0000FF">SUBJECTS are printed BLUE. Deleting a subject line will ALSO delete the attached comment lines AND the extra subject and comment text lines stored in the subject file, if any.</font><br>\n|;
print qq|<font color="#006600">COMMENTS are printed GREEN. Deleting a comment line will ONLY delete that particular comment line AND the extra comment text line stored in the subject file, if any.</font><br>\n|;
print qq|<font size=2>\n|;
for $lineNbr (0..$#bbmFile)
{ @fields = split (/\|/,$bbmFile[$lineNbr]);
$commNbr = $fields[1];
if ($commNbr ==0)
{ $subjNbr = $fields[0];
print qq|<hr>\n<font color="#0000FF"><b>SUBJECT $subjNbr <input type=checkbox name=subjdelete value="$subjNbr"></b>: $fields[2]|;
if (-e "$scriptDir/bbm$subjNbr.txt") { print qq| (View <b><a href="$bbmatUrl/$script/bbm$subjNbr.txt" target="BBM_NEW">bbm$subjNbr.txt</a></b>?)|; }
print qq|<br>\n$fields[6]<br>\n<b>NAME</b>: $fields[3] <b>EMAIL</b>: $fields[4] <b>DATE</b>: $fields[5]</font>\n|;
} elsif ($subjNbr == $fields[0])
{ print qq|<br>\n<font color="#006600"><b>COMMENT $subjNbr\.$commNbr <input type=checkbox name=commdelete value="$subjNbr;$commNbr"></b>: $fields[6]<br>\n|;
print qq|NAME: $fields[3] EMAIL: $fields[4] DATE: $fields[5]</font>\n|;
}
}
print qq|<p></font>\n<input type=submit name=deletebynumber value="DELETE!"> |;
print qq|<input type=reset value=" CLEAR "> <input type=submit value="IGNORE"></form>\n|;
&footer;
} # end listbynumber
######################################################################
# CASE: Delete posts by number
elsif ($Form{'deletebynumber'})
{
open (LOCK,">$BBMFLK") || &endMan ("Write: $BBMFLK");
if (!flock (LOCK,2)) { &endMan ("Lock: $BBMFLK"); }
open (BBM,"+<$BBMDAT") || &endMan ("Read\/Write: $BBMDAT");
flock (BBM,2); seek (BBM,0,0);
$startSize = @bbmFile = <BBM>;
$subjCnt =0; $commCnt =0; $fileCnt =0;
if ($Form{'subjdelete'})
{ @subjects = split (/\0/,$Form{'subjdelete'});
for $x (0..$#subjects)
{ $Subjects{$subjects[$x]} = 'Y';
}
$deleteFlag = 'Y';
}
if ($Form{'commdelete'})
{ @comments = split (/\0/,$Form{'commdelete'});
for $x (0..$#comments)
{ ($subject,$comment) = split (/;/,$comments[$x]);
if (!defined $Subjects{$subject})
{ $Comments{$comments[$x]} = 'Y';
}
$deleteFlag = 'Y';
}
}
if (!$deleteFlag) { &endMan ("No posts were selected for deletion!"); }
$lineNbr =0;
while ($lineNbr <=$#bbmFile)
{ @fields = split (/\|/,$bbmFile[$lineNbr]);
$subjNbr = $fields[0]; $commNbr = $fields[1];
$SUBJFILE = "$scriptDir/bbm$subjNbr.txt";
if ($Subjects{$subjNbr})
{ splice (@bbmFile,$lineNbr,1);
if ($commNbr == 0)
{ $subjCnt++;
# delete subject file
if (-e $SUBJFILE)
{ unlink $SUBJFILE;
$fileCnt++;
}
} else
{ $commCnt++;
}
} elsif ($Comments{"$subjNbr;$commNbr"})
{ splice (@bbmFile,$lineNbr,1);
$commCnt++;
# remove comment from subject file
if (-e $SUBJFILE)
{ open (SUBJECT,"+<$SUBJFILE") || &endMan ("Read\/Write: $SUBJFILE");
flock (SUBJECT,2); seek (SUBJECT,0,0);
@subjFile = <SUBJECT>;
$subjFile[$commNbr] = "\n";
seek (SUBJECT,0,0);
print SUBJECT @subjFile;
truncate (SUBJECT,tell(SUBJECT)); close (SUBJECT);
}
} else
{ $lineNbr++;
}
undef $SUBJFILE; undef @subjFile;
}
seek (BBM,0,0);
print (BBM @bbmFile);
truncate (BBM,tell(BBM)); close (BBM);
close (LOCK);
$endSize = @bbmFile;
print qq|<font color="#0000FF">MAINTENANCE COMPLETED.</font>\n<p>\n|;
print qq|<b>Summary of records processed</b>:<br>\nBBMDAT File: "$BBMDAT"<br>\n|;
print qq| $subjCnt subject lines and $commCnt comment lines were purged.<br>\n|;
print qq| Originally $startSize lines, now $endSize lines in file.<br>\n|;
print qq|$fileCnt related SUBJECT FILES were deleted from "$scriptDir/".\n<p>\n|;
&manager;
&footer;
} # end deletebynumber
######################################################################
# Default case: View manager menu
else
{ &manager;
&footer;
} # end default case
} # end bbman
######################################################################
sub manager # View BBMAN menu
{
if ($_[0]) { $minmonths = $_[0]; } else { $minmonths = 12; }
print qq|<form action="$scriptUrl" method=POST>\n|;
print qq|<input type=hidden name=password value="$Form{'password'}">\n|;
print qq|<input type=hidden name=manager value=1>\n|;
print qq|<table border=1>\n<tr align=right><td>Select FORUM:</td>|;
print qq|<td>Data filesize</td><td>Archive filesize</td><td>Total Bytes</td></tr>\n|;
foreach $scriptKey (keys %Script)
{ print qq|<tr align=right><td align=left><input type=radio name=script value="$scriptKey"|;
if ($script eq $scriptKey) { print " checked"; }
$scriptDir = $Script{$scriptKey};
$datB = (-s "$scriptDir/bbm.dat");
$oldB = (-s "$scriptDir/bbmold.dat");
$totalB = $datB + $oldB;
print qq|\>$scriptKey</td><td>$datB</td><td>$oldB</td><td>$totalB</td></tr>\n|;
}
print qq|</table><br>\n|;
print qq|<hr>\n<b><font color="#006600">Remove SUBJECTS and/or COMMENTS <input type=submit name=listbynumber value="BY NUMBER"><br></font>\n|;
print qq|OR <font color="#0000FF">Remove SUBJECTS inactive for <select name="minmonths" size=1>\n|;
for $x (1..12)
{ if ($x == $minmonths)
{ print "<option selected>$x ";
} else
{ print "<option>$x ";
}
}
print qq|</select>\n or more months <input type=submit name=deletebyage value=" BY AGE "></font></b>\n<hr>\n|;
print qq|ONLY Posts deleted BY AGE will be saved and added to the archive file</form>\n|;
} # end manager
sub footer # print the footer
{
print qq|<br>Completed on $timeStamp.\n|;
print qq|<p><a href="$exitUrl">Exit $headTitle</a>\n|;
print qq|<p><font size=2><i><b>BBMATIC BBS FOR THE WEB</b> is one of <a href="http://www.GetCruising.com/crypt" target="_top">Joe's CGI Scripts From The Crypt!</a></i></font>\n|;
print qq|<p>\n</body></html>\n|;
} # end footer
sub passtest # Test and/or change manager's password
{
$PASSFILE = $_[0];
if (-s $PASSFILE)
{ if ($Form{'password'})
{ open (PASS,"<$PASSFILE");
$passcode = <PASS>;
close (PASS);
chop ($passcode) if $passcode =~ /\n$/;
$lp = length $Form{'password'};
$salt = substr($Form{'password'},$lp-2,1).substr($Form{'password'},1,1);
if ($passcode eq crypt ($Form{'password'},$salt))
{ if ($Form{'newpassword'})
{ $lp = length $Form{'newpassword'};
if ($Form{'newpassword'} =~ /^\w{$lp}\b/)
{ $Form{'password'} = $Form{'newpassword'};
$salt = substr($Form{'password'},$lp-2,1).substr($Form{'password'},1,1);
$passcode = crypt ($Form{'password'},$salt);
open (PASS,">$PASSFILE");
print PASS "$passcode";
close (PASS);
} else
{ &passbox ("Bad choice, Creep!!");
}
}
} else
{ &passbox ("Wrong, Creep!!");
}
} else
{ &passbox ("What's the Password, Creep?");
}
} else
{ &endMan ("Password File $PASSFILE Not Found");
}
}
sub passbox # print the password form
{
print <<__PASSBOX;
<form action="$scriptUrl" method="POST">
<input type=hidden name=manager value=1>
<input type=hidden name=script value="$script">
<table border=4>
<tr><th colspan=2><font color="#FF0000"><b><blink>$_[0]</blink></b></font></th></tr>
<tr><th> Enter Password:</td><th><input type=password name=password size=12 maxlength=12></th></tr>
<tr><th>Change Password:</td><th><input type=text name=newpassword size=12 maxlength=12></th></tr>
<th colspan=2><input type=submit value=" DO IT! "><input type=reset value=" CLEAR "></th></tr>
</table><br>
Password must be 4 to 12 alpha-numeric characters.</form><p>
__PASSBOX
exit;
}
sub endMan # Error handling for manager scripts
{
print qq|<font color="#FF0000"><b>ERROR:</font><br>$_[0]</b>\n<p>|;
if ($!) { print qq|Server made a Boo-Boo! $!\n|; }
else { print qq|Use your browser's [BACK] button and try again.\n|; }
print qq|<p></body></html>\n|;
exit;
} # end endIt
1; # return true