#!/usr/bin/perl
###################################################################
# SCRIPT PARAMETERS (CHANGE HERE).
###################################################################
### URL path where this script resides (+gifies for smilies).
### (can also be a relative url)
$SCRIPTDIR="/board";
### Where are the datafiles stored in ?
$DATADIR="./data";
### background color of table headers
$BGCOLORTBLHEAD="33CCFF";
### title of all boards page
$ALLBOARDS="Michael's Message Board";
### style of fonts (is put into body tag of all generated files.
$FONTSTYLE = "style='font-family:verdana,helvetica,ariel;font-size:11pt'";
###################################################################
### HTTP Header string for HTML result
$HTTPHEADER = "Content-type: text/html\n\n";
### read POST parameters into global $CgiParam{$name}
&parse_form;
$DO = $CgiParam{"do"};
$BOARDID = $CgiParam{"id"};
### change password
if ($DO eq "pword"){
&CheckSecurity;
&ChangePword;
}
### no parameters - show listof message boards.
elsif ($DO eq "newb"){
&CheckSecurity;
&NewBoard;
}
### delete a message board
elsif ($DO eq "delb"){
&CheckSecurity;
&DeleteBoard;
}
### delete a whole thread
elsif ($DO eq "delt"){
&CheckSecurity;
&DeleteThread;
}
### delete a message
elsif ($DO eq "delm") {
&CheckSecurity;
&DeleteMessage;
}
else
{
&AdminBoard;
}
## stupid security
sub ChangePword
{
if (open(PASW,">$DATADIR/passw")) {
$salt = crypt($CgiParam{'npassw'},"KuKuKuKu");
print PASW "$salt";
close(PASW);
print "$HTTPHEADER
User has been changed.
";
}
}
## stupid security
sub CheckSecurity
{
if (open(PASW,"$DATADIR/passw")) {
$p = ;
close(PASW);
if (crypt($CgiParam{"passw"},$p) eq $p) {
}
else {
die "$HTTPHEADER
False username or password
Please try again";
}
}
}
### read POST parameters into global $CgiParam{$name}
sub parse_form
{
local($name,$value,$meth,$in,$len,$got,@pairs,$pair);
$meth = $ENV{'REQUEST_METHOD'};
# Get the request data
if (!defined $meth || $meth eq '' || $meth eq 'GET' || $meth eq 'HEAD') {
$in = $ENV{'QUERY_STRING'};
}
elsif ($meth eq 'POST') {
$len = $ENV{'CONTENT_LENGTH'};
$got = read(STDIN, $in, $len);
($got==$len) || die "$HTTPHEADER Can't read POST data $got $len\n";
}
else {
die "$HTTPHEADER Unknown request method: $meth\n";
}
# Split the name-value pairs
@pairs = split(/&/, $in);
foreach $pair (@pairs) {
($name, $value) = split(/=/, $pair);
# Un-Webify plus signs and %-encoding
$value =~ tr/+/ /;
$value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
# Remove any NULL characters, Server Side Includes
$value =~ s/\0//g;
$value =~ s///g;
$CgiParam{$name} = $value;
}
}
### force the user to enter a password.
### force password
### argument - the realm of the error message if things go wrong.
### get a unique number key.
sub get_number
{
CreateIfNotThere("$DATADIR/$_[0]");
open(NUMBER,"+<$DATADIR/$_[0]");
flock(NUMBER,2); ## exclusive write lock.
#seek(BOARD,0,0);
$num = ;
if ($num == 999999 || $num !~ /^\d+$/) {
$num = "1";
}
else {
$num++;
}
seek(NUMBER,0,0);
print NUMBER "$num";
close(NUMBER);
$num;
}
### creates a file if it does not exist.
sub CreateIfNotThere
{
if (!open(CHECK,"$_[0]")) {
open(CHECK,">$_[0]") || die "$HTTPHEADER Can't create $_[0]";
}
close(CHECK);
}
### write the admin html
sub AdminBoard
{
print <Message board administration
ENDOFTEXT
}
### write a select tag with the titles of all message boards.
sub BoardSelect
{
print "";
}
### create a new message board
sub NewBoard
{
### process form parameters
$ttl = $CgiParam{'title'};
$ttl =~ s/##//g;
$ttl =~ s/\n//g;
$msg = $CgiParam{"message"};
$msg =~ s/
/>/g;
$msg =~ s/\n\n/
/g;
$msg =~ s/\n/ /g;
$msg =~ s/##//g;
$boardid = get_number("allboards.num");
### copy board list and put the new board first.
CreateIfNotThere("$DATADIR/allboards.data");
open(BOARD,"+<$DATADIR/allboards.data") || die "$HTTPHEADER Can't open allobards.data";
flock(BOARD,2); ## exclusive write lock
@lines=;
seek(BOARD,0,0);
print BOARD "$boardid##$ttl##$msg\n";
foreach $line (@lines) {
print BOARD "$line";
}
close(BOARD);
### create empty message board subject list that also contains the title
$filename="$DATADIR/board_$boardid.data";
open(BOARD,">$filename");
print BOARD "$ttl\n";
close(BOARD);
### ok message.
print "$HTTPHEADER
The message board has been added
";
}
### deletes a message board
sub DeleteBoard
{
### delete the entry from the list of all message boards.
open(BOARD,"+<$DATADIR/allboards.data") || die "$HTTPHEADER can't open allboards.data";
flock(BOARD,2); ## exclusive write lock
@lines=;
seek(BOARD,0,0);
foreach $line (@lines) {
($tid) = split(/##/, $line);
if ($tid != $BOARDID) {
print BOARD "$line";
}
}
truncate(BOARD,tell(BOARD));
close(BOARD);
### delete data files.
if ($CgiParam{"delfile"} eq "on")
{
@tmp=<$DATADIR/thread_$BOARDID\_*.*>;
unlink @tmp;
@tmp=<$DATADIR/board_$BOARDID\.*>;
unlink @tmp;
}
### ok message.
print "$HTTPHEADER
The message board has been deleted
";
}
### delete thread
sub DeleteThread
{
$THREADID = $CgiParam{"tid"};
$filename="$DATADIR/board_$BOARDID.data";
CreateIfNotThere($filename);
open(BOARD,"+<$filename") || die "$HTTPHEADER can't open $filename";
flock(BOARD,2); ## exclusive write lock
$BOARDTITLE=;
@lines = ;
seek(BOARD,0,0);
print BOARD $BOARDTITLE;
$nmsg=0;
foreach $line (@lines) {
($tid) = split(/##/, $line);
if ($tid != $THREADID) {
print BOARD $line;
}
else {
($tid, $pic, $nmsg) = split(/##/, $line);
}
}
truncate(BOARD,tell(BOARD));
close(BOARD);
if ($CgiParam{"delfile"} eq "on")
{
@tmp=<$DATADIR/thread_$BOARDID\_$THREADID.*>;
unlink @tmp;
}
## update count of messages in board list.
AddToBoardList($DATADIR,$BOARDID,"",-$nmsg) if ($nmsg != 0);
### ok message.
print "$HTTPHEADER
The thread has been deleted
";
}
### delete a message from a thread.
sub DeleteMessage
{
$THREADID = $CgiParam{"tid"};
$MSGID = $CgiParam{"mid"};
$DELALL = $CgiParam{"delall"} eq "on";
$threadfile = "$DATADIR/thread_$CgiParam{'id'}_$THREADID";
CreateIfNotThere("$threadfile.htm");
open(THREAD,"+<$threadfile.htm") || die "$HTTPHEADER Can't open file $threadfile";
flock(THREAD,2); ## exclusive write lock
@threadlines = ;
seek(THREAD,0,0);
$mode=0;
$deletedcount=0;
foreach $line (@threadlines) {
if ($mode==0) {
if ($line =~ /\/ && $1==$MSGID) {
$deletedcount++;
$mode=1;
$indent=$2;
}
else {
print THREAD $line;
}
}
elsif ($mode==1) {
if ($line =~ /\/) {
if ($DELALL==0) {
$mode=2;
}
else {
if ($2<=$indent) {
$mode=2;
}
else {
$deletedcount++;
}
}
}
}
if ($mode==2) {
print THREAD $line;
}
}
truncate(THREAD,tell(THREAD));
close(THREAD);
## update count of messages in board list.
AddToBoardList($DATADIR,$BOARDID,"",-$deletedcount);
### ok message.
print "$HTTPHEADER
The message has been deleted
";
}
### Update count of messages and date of last message
#
# $_[0] - data directory
# $_[1] - board id
#
# $_[2] - date string
#
# $_[3] - increment.
#
###
sub AddToBoardList
{
local(@boardlines,$filename,$line,$tid, $subject, $comment, $nummsg ,$date_time);
$filename="$_[0]/allboards.data";
CreateIfNotThere("$filename");
open(BOARD,"+<$filename") || die "$HTTPHEADER Can't open file $filename";
flock(BOARD,2); ## exclusive write lock
@boardlines=;
seek(BOARD,0,0);
### write changes back.
foreach $line (@boardlines) {
if (!($line=="\n" || $line=="")) {
chop($line);
($tid, $subject, $comment, $nummsg, $date_time) = split(/##/, $line);
if ($BOARDID == $tid) {
$nummsg += $_[3];
$date_time=$_[2] if ($_[2] ne "");
}
print BOARD "$tid##$subject##$comment##$nummsg##$date_time\n";
}
}
truncate(BOARD,tell(BOARD));
close(BOARD);
}