#!/usr/local/bin/perl ###################################################################### # BEFORE TRYING TO EDIT THIS SCRIPT, READ THE README FILE ###################################################################### # # The Dream Catcher's Web Free CGI Scripts # Message Board # Created by Seth Leonard # # http://dreamcatchersweb.com/scripts/ # # (c)2000 Seth Leonard # All Rights Reserved # ###################################################################### $userdir = "users"; $datafile = "data.txt"; $messagedir = "messages"; $responsedir = "responses"; $archivedir = "archives"; $dateprogram = "/bin/date"; $bgcolor = "FFFFFF"; $textcolor = "000000"; $linkcolor = "0000FF"; $boardname = "Message Board"; $loginpage = "http://server.com/board/login.html"; $script = "http://server.com/cgi-bin/board.cgi"; ############################################################################ &getdate; if ($ENV{'QUERY_STRING'}) { $namevalues = $ENV{'QUERY_STRING'}; } else { read(STDIN, $namevalues, $ENV{'CONTENT_LENGTH'}); } @pairs = split(/&/, $namevalues); 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/<([^>]|\n)*>//g; $INPUT{$name} = $value; } $action = $INPUT{'action'}; if ($action eq 'login') { &login; } if ($action eq 'main') { &main; } if ($action eq 'view') { &view; } if ($action eq 'post') { &post; } if ($action eq 'userarchive') { &userarchive; } if ($action eq 'viewarchive') { &viewarchive; } if ($action eq 'editarchive') { &editarchive; } if ($action eq 'deletearchive') { &deletearchive; } if ($action eq 'archivemessage') { &archivemessage; } if ($action eq 'register') { ®ister; } ############################################################################ # REGISTER ############################################################################ sub register { unless ($INPUT{'user'}) { &requireuser; } &user; $filetoexist = "$userdir/$user.user"; @atribs = stat("$filetoexist"); if ($atribs[7] > 0 || $INPUT{'user'} eq 'guest') { &usernametaken; } $INPUT{'password'} =~ tr/ /-/; $cryptpassword = crypt($INPUT{'password'}, sb); open (NEWUSER, ">$userdir/$user.user"); print NEWUSER ("$cryptpassword\n"); if ($INPUT{'alias1'}) { print NEWUSER ("$INPUT{'alias1'}"); } if ($INPUT{'alias2'}) { print NEWUSER ("\t"); print NEWUSER ("$INPUT{'alias2'}"); } if ($INPUT{'alias3'}) { print NEWUSER ("\t"); print NEWUSER ("$INPUT{'alias3'}"); } if ($INPUT{'alias4'}) { print NEWUSER ("\t"); print NEWUSER ("$INPUT{'alias4'}"); } if ($INPUT{'alias5'}) { print NEWUSER ("\t"); print NEWUSER ("$INPUT{'alias5'}"); } print NEWUSER ("\n"); if ($INPUT{'email'} && $INPUT{'email'} =~ /(.*)@(.*)/) { print NEWUSER ("$INPUT{'email'}\n"); } else { print NEWUSER ("none\n"); } print NEWUSER ("$INPUT{'archive'}\n"); close (NEWUSER); if ($INPUT{'archive'} eq 'yes') { open (NEWARCHIVE, ">$archivedir/$user.archive"); close (NEWARCHIVE); } print ("Content-type: text/html\n\n"); print <<"html"; Thank You For Registering
Thank you for Registering

Welcome to $boardname $userview,

Please go to the login page and login using the username '$userview' and the password '$INPUT{'password'}'.

Thank you!
©1997 Dream Catchers Technologies, Inc. html exit; } ############################################################################ # MAIN MENU ############################################################################ sub login { &user; &checkpassword; print ("Content-type: text/html\n\n"); print <<"html"; Welcome To $boardname
Welcome to $boardname

You have the following options:

html unless ($user eq 'guest') { print <<"html"; html } print <<"html";

©1997 Dream Catchers Technologies, Inc. html exit; } ############################################################################ # VIEW BOARD ############################################################################ sub main { &user; &checkpassword; &getuserinfo; opendir (MESSAGES, "$messagedir"); @files = readdir(MESSAGES); close (MESSAGES); $numberoffiles = @files; $numberoffiles -= 1; @rmessages = @files[2..$numberoffiles]; foreach $message (@rmessages) { $x = 1; while ($x < @rmessages) { if ($rmessages[$x - 1] > $rmessages[$x]) { @rmessages[$x - 1, $x] = @rmessages[$x, $x - 1]; } $x++; } } @messages = reverse(@rmessages); print ("Content-type: text/html\n\n"); print <<"html"; $boardname
$boardname


[ Main Menu ]

©1997 Dream Catchers Technologies, Inc. html } else { print <<"html";
html if ($userarchive eq 'available') { print ("\n"); } print <<"html";
Name:
Subject:
Archive:\n"); print (" Yes\n"); print (" No\n"); print ("
Post:



©1997 Dream Catchers Technologies, Inc. html } exit; } ############################################################################ # VIEW A MESSAGE ############################################################################ sub view { &user; &checkpassword; if ($INPUT{'location'} eq 'messages') { $dir = $messagedir; } else { $dir = $responsedir; } open (MESSAGE, "$dir/$INPUT{'message'}.txt"); ($subject, $name, $postunder, $responses, $date, $puser, $post) = ; close (MESSAGE); chop ($subject) if ($subject =~ /\n$/); chop ($name) if ($name =~ /\n$/); chop ($postunder) if ($postunder =~ /\n$/); chop ($responses) if ($responses =~ /\n$/); chop ($date) if ($date =~ /\n$/); chop ($puser) if ($puser =~ /\n$/); chop ($post) if ($post =~ /\n$/); &getpostunderinfo; &getpostuserinfo; print ("Content-type: text/html\n\n"); print <<"html"; $subject
$subject

html if ($INPUT{'location'} eq 'messages') { $no = "yes"; } else { print ("\n"); } print <<"html"; html if ($puserarchive eq 'available') { print ("\n"); } else { print ("\n"); } print <<"html";
Posted By:$name
Response to:$osubject posted by $oname
Email:$pemail
Date:$date
Archive:Available
Archive:Not Available

$post
Responses:
html if ($user eq 'guest') { print <<"html";
[ Main Menu ]

©1997 Dream Catchers Technologies, Inc. html } else { &getuserinfo; print <<"html"; Post Response:

html if ($INPUT{'location'} eq 'messages') { $status = "original"; } else { $status = "response"; } print <<"html"; html if ($userarchive eq 'available') { print ("\n"); } print <<"html";
Name:
Subject:
Archive:\n"); print (" Yes\n"); print (" No\n"); print ("
Post:



[ $boardname ] [ Main Menu ]

©1997 Dream Catchers Technologies, Inc. html } exit; } ############################################################################ # POST A MESSAGE ############################################################################ sub post { $INPUT{'message'} =~ s/\cM\n/
/g; $post = $INPUT{'message'}; &user; &checkpassword; open (DATA, "$datafile"); $count = ; close (DATA); chop ($count) if ($count =~ /\n$/); $count += 1; open (DATA, ">$datafile"); print DATA ("$count"); close (DATA); if ($INPUT{'postunder'} eq 'main') { open (NEWFILE, ">$messagedir/$count.txt"); print NEWFILE ("$INPUT{'subject'}\n"); print NEWFILE ("$INPUT{'name'}\n"); print NEWFILE ("$INPUT{'postunder'}\n"); print NEWFILE ("\n"); print NEWFILE ("$date\n"); print NEWFILE ("$user\n"); print NEWFILE ("$post\n"); close (NEWFILE); } else { open (NEWFILE, ">$responsedir/$count.txt"); print NEWFILE ("$INPUT{'subject'}\n"); print NEWFILE ("$INPUT{'name'}\n"); print NEWFILE ("$INPUT{'postunder'}\n"); print NEWFILE ("\n"); print NEWFILE ("$date\n"); print NEWFILE ("$user\n"); print NEWFILE ("$post\n"); close (NEWFILE); if ($INPUT{'status'} eq 'original') { $dir = $messagedir; } else { $dir = $responsedir; } open (UNDER, "$dir/$INPUT{'postunder'}.txt"); @lines = ; close (UNDER); chop ($lines[3]) if ($lines[3] =~ /\n$/); if ($lines[3] eq "") { $responses = $count; } else { $responses = $count . 'x' . $lines[3]; } open (UNDER, ">$dir/$INPUT{'postunder'}.txt"); print UNDER ("$lines[0]"); print UNDER ("$lines[1]"); print UNDER ("$lines[2]"); print UNDER ("$responses\n"); print UNDER ("$lines[4]"); print UNDER ("$lines[5]"); print UNDER ("$lines[6]"); close (UNDER); } if ($INPUT{'archive'} eq 'yes') { open (ARCHIVE, ">>$archivedir/$user.archive"); print ARCHIVE ("$INPUT{'subject'}\t"); print ARCHIVE ("$date\t"); print ARCHIVE ("$post\n"); close (ARCHIVE); open (ARCHIVE, "$archivedir/$user.archive"); @lines = ; close (ARCHIVE); $lines = @lines; if ($lines > 10) { open (ARCHIVE, ">$archivedir/$user.archive"); print ARCHIVE ("$lines[$lines - 10]"); print ARCHIVE ("$lines[$lines - 9]"); print ARCHIVE ("$lines[$lines - 8]"); print ARCHIVE ("$lines[$lines - 7]"); print ARCHIVE ("$lines[$lines - 6]"); print ARCHIVE ("$lines[$lines - 5]"); print ARCHIVE ("$lines[$lines - 4]"); print ARCHIVE ("$lines[$lines - 3]"); print ARCHIVE ("$lines[$lines - 2]"); print ARCHIVE ("$lines[$lines - 1]"); } } &getuserinfo; print ("Content-type: text/html\n\n"); print <<"html"; $INPUT{'subject'}
$INPUT{'subject'}

html if ($userarchive eq 'available') { print ("\n"); } else { print ("\n"); } print <<"html";
Posted By:$INPUT{'name'}
Email:$email
Date:$date
Archive:Available
Archive:Not Available

$post

©1997 Dream Catchers Technologies, Inc. html exit; } ############################################################################ # VIEW A USER'S ARCHIVE ############################################################################ sub userarchive { &user; $archive = $INPUT{'archive'}; $archive =~ tr/ /_/; $archiveview = $INPUT{'archive'}; $archiveview =~ tr/_/ /; open (ARCHIVE, "$archivedir/$archive.archive"); @lines = ; close (ARCHIVE); print ("Content-type: text/html\n\n"); print <<"html"; $archiveview Archive $archiveview Archive
    html $archivenum = 0; foreach $line (@lines) { ($subject, $date, $post) = split(/\t/, $line); print ("
  • $subject posted on $date
  • \n"); $archivenum += 1; } print <<"html";

[ $boardname ] [ Main Menu ]

©1997 Dream Catchers Technologies, Inc. html exit; } ############################################################################ # PAGE TO INPUT USER FOR ARCHIVE ############################################################################ sub viewarchive { &user; &checkpassword; print ("Content-type: text/html\n\n"); print <<"html"; View an Archive
View an Archive

Please type the name of the user who's archive you would like to view:


©1997 Dream Catchers Technologies, Inc. html exit; } ############################################################################ # EDIT ARCHIVE ############################################################################ sub editarchive { &user; &checkpassword; open (ARCHIVE, "$archivedir/$user.archive"); @lines = ; close (ARCHIVE); print ("Content-type: text/html\n\n"); print <<"html"; Edit Your Archive Edit Your Archive
Select which archive message you would like to delete:

html $archivenum = 0; foreach $line (@lines) { ($subject, $date, $post) = split(/\t/, $line); print (" $subject posted on $date
\n"); $archivenum += 1; } print <<"html";

[ $boardname ] [ Main Menu ]

©1997 Dream Catchers Technologies, Inc. html exit; } ############################################################################ # DELETE ARCHIVE MESSAGES ############################################################################ sub deletearchive { &user; &checkpassword; open (ARCHIVE, "$archivedir/$user.archive"); @lines = ; close (ARCHIVE); $thecount = 0; open (ARCHIVE, ">$archivedir/$user.archive"); foreach $line (@lines) { if ($thecount == $INPUT{'delete'}) { $thecount += 1; } else { print ARCHIVE ("$line"); $thecount += 1; } } print ("Location: $script?action=userarchive&archive=$user&user=$user&password=$INPUT{'password'}\n\n"); exit; } ############################################################################ # VIEW AN ARCHIVE MESSAGE ############################################################################ sub archivemessage { &user; $archive = $INPUT{'archive'}; $archive =~ tr/ /_/; $archiveview = $INPUT{'archive'}; $archiveview =~ tr/_/ /; $archivenumber = $INPUT{'archivenumber'}; open (ARCHIVE, "$archivedir/$archive.archive"); @lines = ; close (ARCHIVE); ($subject, $date, $post) = split(/\t/, $lines[$archivenumber]); $puser = $archive; &getpostuserinfo; print ("Content-type: text/html\n\n"); print <<"html"; $subject
$subject

Posted By:$archiveview
Email:$pemail
Date:$date

$post
[ $archiveview Archive ] [ $boardname ] [ Main Menu ]
html exit; } ############################################################################ # SUB ROUTINES ############################################################################ sub getuserinfo { open (USER, "$userdir/$user.user"); @userinfo = ; close (USER); foreach $line (@userinfo) { chop ($line) if ($line =~ /\n$/); } if ($userinfo[1] eq "") { $aliases = 0; } else { @aliases = split(/\t/, $userinfo[1]); $aliases = @aliases; } if ($userinfo[2] eq 'none') { $email = "Not Given"; } else { $email = "$userinfo[2]"; } if ($userinfo[3] eq 'yes') { $userarchive = "available"; } else { $userarchive = "not available"; } } sub checkpassword { unless ($user eq 'guest') { unless (-e "$userdir/$user.user") { &userdoesntexist; } $userpassword = crypt($INPUT{'password'}, sb); open (USER, "$userdir/$user.user"); $password = ; close (USER); chop ($password) if ($password =~ /\n$/); unless ($password eq $userpassword) { print ("Content-type: text/html\n\n"); print ("\n"); print ("You Entered an Illegal Password\n"); print ("\n"); exit; } } } sub getdate { $day = `$dateprogram +"%d"`; chop ($day) if ($day =~ /\n$/); unless ($day == 10 || $day == 20 || $day == 30) { $day =~ tr/0/ /; } $date = `$dateprogram +"%B $day, %Y"`; chop ($date) if ($date =~ /\n$/); } sub usernametaken { print ("Content-type: text/html\n\n"); print ("\n"); print ("The User Name you selected is already in use, please choose another\n"); print ("\n"); exit; } sub userdoesntexist { print ("Content-type: text/html\n\n"); print ("\n"); print ("You Entered an Illegal User Name\n"); print ("\n"); exit; } sub requireuser { print ("Content-type: text/html\n\n"); print ("\n"); print ("You Did Not Enter a User Name, Please Do So\n"); print ("\n"); exit; } sub getpostuserinfo { open (USER, "$userdir/$puser.user"); @puserinfo = ; close (USER); foreach $line (@puserinfo) { chop ($line) if ($line =~ /\n$/); } if ($puserinfo[1] eq "") { $paliases = 0; } else { @paliases = split(/\t/, $puserinfo[1]); $paliases = @paliases; } if ($puserinfo[2] eq 'none') { $pemail = "Not Given"; } else { $pemail = "$puserinfo[2]"; } if ($puserinfo[3] eq 'yes') { $puserarchive = "available"; } else { $puserarchive = "not available"; } } sub getpostunderinfo { $filetoexist = "$messagedir/$postunder.txt"; @atribs = stat("$filetoexist"); if ($atribs[7] > 0) { open (OVER, "$filetoexist"); ($osubject, $oname, $opostunder, $oresponses, $odate, $opuser, $opost) = ; close (OVER); } else { open (OVER, "$responsedir/$postunder.txt"); ($osubject, $oname, $opostunder, $oresponses, $odate, $opuser, $opost) = ; close (OVER); } chop ($osubject) if ($osubject =~ /\n$/); chop ($oname) if ($oname =~ /\n$/); chop ($opostunder) if ($opostunder =~ /\n$/); chop ($oresponses) if ($oresponses =~ /\n$/); chop ($odate) if ($odate =~ /\n$/); chop ($opuser) if ($opuser =~ /\n$/); chop ($opost) if ($opost =~ /\n$/); } sub getresponseinfo { open (OVER, "$responsedir/$response.txt"); ($rsubject, $rname, $rpostunder, $rresponses, $rdate, $rpuser, $rpost) = ; close (OVER); chop ($rsubject) if ($rsubject =~ /\n$/); chop ($rname) if ($rname =~ /\n$/); chop ($rpostunder) if ($rpostunder =~ /\n$/); chop ($rresponses) if ($rresponses =~ /\n$/); chop ($rdate) if ($rdate =~ /\n$/); chop ($rpuser) if ($rpuser =~ /\n$/); chop ($rpost) if ($rpost =~ /\n$/); } sub user { $user = $INPUT{'user'}; $userview = $INPUT{'user'}; $userview =~ tr/_/ /; $user =~ tr/ /_/; }