ethereal-1.0.0/ 40755 0 0 0 7053650321 11264 5ustar rootrootethereal-1.0.0/config/ 40755 0 0 0 7053646576 12552 5ustar rootrootethereal-1.0.0/config/config-puppet.plx100755 0 0 32024 7053646576 16200 0ustar rootroot#!/bin/perl ################################################################################# # Created : Martin Foster # Modified : 01/30/2000 ################################################################################# # # Configure Puppet - Script part of Webchat designed to configure Puppets # Copyright (C) 2000 Martin Foster # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # # Author of this script can be contacted at the following: # E-Mail : mfoster@redwhite.com # Address : Suite 209 - 355 5th Ave NE # Calgary, Alberta # T2R 0K9 # ################################################################################# use CGI qw(:standard); # Common gateway interface use CGI::Carp qw(fatalsToBrowser); # CGI Error logs use strict; # Strict variable enforcement use Image::Grab; # Image grabber use Image::Size; # Image sizer use String::Random; # Random String generator use Webchat::Database; # Database handler use Webchat::Dbm; # DBM Addition use Webchat::Login; # Login functionality use Webchat::Param; # Parameter control use Webchat::Table; # Table control ################################################################################# # Data Members ################################################################################# my $Database; # Database handle my $cgi; # Common gateway interface handle my %param; # Parameter hash my %config; # Configuration tag ################################################################################# # Program Area ################################################################################# $cgi = new CGI; # Create CGI Handle Webchat::Database::DatabaseConnect(\$Database); # Connect to MySQL Webchat::Param::GetParam($cgi, \%param); # Retreive parameters Webchat::Dbm::DBMOpenConfig(\%config); # Attach hash print $cgi->header(); # File header Webchat::Database::DocumentGetHeader($Database); # HTML header # Authenthication if ( Webchat::Login::GetVerificationNormal($Database, $cgi, \%param) ) { print "$config{'TagTitle'}\n
\n"; # Print title # For additions and removal unless ((defined($param{$config{'TxtSubmitView'}})) || (defined($param{$config{'TxtSubmitButton'}}))) { InitialDisplay($Database, $cgi, \%param, \%config); } # For puppet changes and viewing else { PuppetControl($Database, $cgi, \%param, \%config); } } Webchat::Database::DocumentGetFooter($Database); # HTML footer Webchat::Dbm::DBMClose(\%config); # Release hash $Database->disconnect(); # Disconnect database handle ################################################################################# # Sub-Routines ################################################################################# ##################### # ImageSize # # Downloads a picture off the net and determins it's size as to be able place # the defined sizes on the database sub ImageSize { #################### # Data Members my $image; # Image handle my $rand; # Random handle my $link = shift; # URL to picture my $name; # Name of file my %system; # System hash my @sizes; # Size returned #################### # Program Area Webchat::Dbm::DBMOpenSystem(\%system); # Link DBM from hash # Initialize handles $image = new Image::Grab; $rand = new String::Random; # Generate random name $name = $rand->randpattern("cccccccc"); $name = "$system{'LocTemp'}/$name"; # Retreive image $image->url($link); $image->grab; # Write to file open(IMAGE, ">$name") || die("Cannot open $name : $!"); # Open filehandle print IMAGE $image->image; # Write to filehandle close(IMAGE); # Close filehandle # Determine image size and remove file @sizes = imgsize("$name"); unlink("$name"); Webchat::Dbm::DBMClose(\%system); # Unlink DBM from hash return @sizes; # Return values } ##################### # InitialDisplay # # Handles the general output of the initial display screen. Which will allow one # to change password, E-Mail addresses and/or passwords. sub InitialDisplay # Database, CGI, Param { ##################### # Data members my $Database = shift; # Database handle my $Statement; # Database statement my $cgi = shift; # CGI handle my $param = shift; # Parameter handle my $config = shift; # Config hash my @puppets; # Array of puppets my $list; # List of puppets my $buttonview; # Button view my $buttonrem; # Button remove my $buttons; # Buttons used my $choice; # Choice of the matter ##################### # Program area # Addition operation if ( defined($param->{$config->{'TxtSubmitAddition'}}) ) { # Prepare and execute $Statement = $Database->prepare("SELECT PuppetName FROM Puppet WHERE PuppetName=?"); $Statement->execute(Webchat::Login::Unmangle($param->{'PUPADD'})); # Retreival and finish $choice = $Statement->fetchrow(); $Statement->finish(); # Verification if ((($param->{'PUPADD'} =~ tr/a-zA-Z1-9//) > 4) && (!defined($choice))) { # Insertion upon acceptance $Database->do("INSERT INTO Puppet VALUES(?,?,NULL,NULL,NULL,NULL,NULL,NULL,NULL,NULL)", {}, Webchat::Login::Unmangle($param->{'PUPADD'}), Webchat::Login::Unmangle($param->{'USER'}) ); } } # Removal operation if ( defined($param->{$config->{'TxtSubmitDelete'}}) ) { # Prepare and execute $Statement = $Database->prepare("SELECT PuppetName FROM Puppet WHERE PuppetName=?"); $Statement->execute(Webchat::Login::Unmangle($param->{'PUPPET'})); # Retreival and finish $choice = $Statement->fetchrow(); $Statement->finish(); # Verification if (defined($choice)) { # Removal of secondary tables $Database->do("DELETE FROM PuppetInvitation WHERE PuppetName=?", {}, $param->{'PUPPET'} ); $Database->do("DELETE FROM PuppetIgnore WHERE PuppetName=?", {}, $param->{'PUPPET'} ); # Removal of primary tables $Database->do("DELETE FROM Puppet WHERE PuppetName=?", {}, $param->{'PUPPET'} ); } } # Display of values # Retreive a list of puppets Webchat::Database::GetListPuppetYours($Database, \@puppets, Webchat::Login::Unmangle($param->{'USER'})); # Prepare widgets $list = $cgi->scrolling_list('PUPPET', \@puppets, $puppets[0], 10); $buttonview = $cgi->submit($config->{'TxtSubmitView'}); $buttonrem = $cgi->submit($config->{'TxtSubmitDelete'}); $buttons = "$buttonview

$buttonrem"; # Selection/removal # Beginning of table and form print $cgi->start_form(); Webchat::Table::MakeTop($cgi); # Select puppet Webchat::Table::MakeSingle($cgi, $config->{'TagPupDelSelect'}); Webchat::Table::MakeValid($cgi, $list, $buttons); Webchat::Table::MakeBlank($cgi); # Select kit Webchat::Table::MakeSingle($cgi, $config->{'TagPupAddition'}); Webchat::Table::MakeValid($cgi, $cgi->textfield('PUPADD', '', 20, 30), $cgi->submit($config->{'TxtSubmitAddition'})); Webchat::Table::MakeBottom($cgi); Webchat::Param::EmbedNormal($Database, $cgi, $param); print $cgi->end_form(); } ##################### # PuppetControl # # Sub-routine that will handle the change of information for a puppet. This # is assuming that the submit button was pressed. sub PuppetControl { ##################### # Data members my $Database = shift; # Database handle my $cgi = shift; # CGI handle my $param = shift; # Parameter handle my $config = shift; # Config hash my @info; # Gathered information ##################### # Program area # Simplication of steps and code $param->{'USER'} = Webchat::Login::Unmangle($param->{'USER'}); $param->{'PUPPET'} = Webchat::Login::Unmangle($param->{'PUPPET'}); # Change of information and verify for appripriate button press if ( defined($param->{$config->{'TxtSubmitButton'}}) ) { PuppetControlWrite($Database, $param); } # Gather information @info = Webchat::Database::DataGetPuppetInfo($Database, $param->{'PUPPET'}); # Display of information # Write top of table and form print $cgi->start_form(); Webchat::Table::MakeTop($cgi); # Most clueful information Webchat::Table::MakeValid($cgi, $config->{'TagPupName'}, "$info[0]"); Webchat::Table::MakeBlank($cgi); # Spacer # Image information Webchat::Table::MakeValid($cgi, $config->{'TagPupImageLink'}, $cgi->textfield('PUPIMG', $info[3], 30, 200)); Webchat::Table::MakeValid($cgi, $config->{'TagPupImgWidth'}, "$info[5]"); Webchat::Table::MakeValid($cgi, $config->{'TagPupImgHeight'}, "$info[4]"); Webchat::Table::MakeBlank($cgi); # Spacer # More complexe tagline Webchat::Table::MakeSingle($cgi, $config->{'TagPupTagline'}); Webchat::Table::MakeSingle($cgi, "" ); Webchat::Table::MakeBlank($cgi); # Spacer # More complexe title Webchat::Table::MakeSingle($cgi, $config->{'TagPupTitle'}); Webchat::Table::MakeSingle($cgi, ""); Webchat::Table::MakeBlank($cgi); # Spacer # More complexe bio Webchat::Table::MakeSingle($cgi, $config->{'TagPupBio'}); Webchat::Table::MakeSingle($cgi, $cgi->textarea('PUPBIO', $info[7], 5, 65)); Webchat::Table::MakeBlank($cgi); # Spacer # Finish table Webchat::Table::MakeValid($cgi, $cgi->submit($config->{'TxtSubmitButton'}), $cgi->reset($config->{'TxtResetButton'})); Webchat::Table::MakeBottom($cgi); # Embed Webchat::Param::EmbedNormal($Database, $cgi, $param); print "\t", $cgi->hidden('PUPPET', $param->{'PUPPET'}), "\n"; # End table and form Webchat::Table::MakeBottom($cgi); print $cgi->end_form(); } ##################### # PuppetControlWrite # # Sub-routine that will handle the change of information for a puppet. This # is used as a sub process to handle database interaction. sub PuppetControlWrite { ##################### # Data members my $Database = shift; # Database handle my $param = shift; # Parameter handle my $height; # Image height my $width; # Image width ##################### # Program area # If valid URL if (($param->{'PUPIMG'} =~ tr/a-zA-Z0-9\:\///) > 10) { # Capture and determin size ($width, $height) = ImageSize($param->{'PUPIMG'}); # Update database with new information $Database->do("UPDATE Puppet SET PuppetPic=?, PuppetPicWidth=?, PuppetPicHeight=? WHERE PuppetName=? AND PuppeteerLogin=?", {}, $param->{'PUPIMG'}, $width, $height, $param->{'PUPPET'}, $param->{'USER'}); } else { # Update database with nulls $Database->do("UPDATE Puppet SET PuppetPic=NULL, PuppetPicWidth=NULL, PuppetPicHeight=NULL WHERE PuppetName=? AND PuppeteerLogin=?", {}, $param->{'PUPPET'}, $param->{'USER'}); } # Scrub HTML if ( defined($param->{'PUPTAG'}) ) # For tagline { $param->{'PUPTAG'} =~ s/<[^>]*>//gs; } if ( defined($param->{'PUPTIT'}) ) # For title { $param->{'PUPTIT'} =~ s/<[^>]*>//gs; } # Truncate and clean output my $cleantit = DBI::neat($param->{'PUPTIT'}, 500); my $cleantag = DBI::neat($param->{'PUPTAG'}, 500); # Remove single quotes $cleantit =~ s/\'//g; $cleantag =~ s/\'//g; # Database update # For Tagline if (($cleantag =~ tr/a-zA-Z0-9\:\/*()//) > 3) { # Actual tagline $Database->do("UPDATE Puppet SET PuppetTag=? WHERE PuppetName=? AND PuppeteerLogin=?", {}, $cleantag, $param->{'PUPPET'}, $param->{'USER'}); } else { # Reset tagline $Database->do("UPDATE Puppet SET PuppetTag=NULL WHERE PuppetName=? AND PuppeteerLogin=?", {}, $param->{'PUPPET'}, $param->{'USER'}); } # For title if (($cleantit =~ tr/a-zA-Z0-9\:\/*()//) > 3) { # Actual title $Database->do("UPDATE Puppet SET PuppetTitle=? WHERE PuppetName=? AND PuppeteerLogin=?", {}, $cleantit, $param->{'PUPPET'}, $param->{'USER'}); } else { # Reset tagline $Database->do("UPDATE Puppet SET PuppetTitle=NULL WHERE PuppetName=? AND PuppeteerLogin=?", {}, $param->{'PUPPET'}, $param->{'USER'}); } # For Bio if (($param->{'PUPBIO'} =~ tr/a-zA-Z0-9\:\/*()//) > 3) { # Actual bio $Database->do("UPDATE Puppet SET PuppetBio=? WHERE PuppetName=? AND PuppeteerLogin=?", {}, $param->{'PUPBIO'}, $param->{'PUPPET'}, $param->{'USER'}); } else { # Reset tagline $Database->do("UPDATE Puppet SET PuppetBio=NULL WHERE PuppetName=? AND PuppeteerLogin=?", {}, $param->{'PUPPET'}, $param->{'USER'}); } } ethereal-1.0.0/config/config-realm.plx100755 0 0 37743 7053646576 16000 0ustar rootroot#!/bin/perl ################################################################################# # Created : Martin Foster # Modified : 02/18/2000 ################################################################################# # # Config Realm - Script part of Webchat designed fro supervisors to control realms # Copyright (C) 2000 Martin Foster # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # # Author of this script can be contacted at the following: # E-Mail : mfoster@redwhite.com # Address : Suite 209 - 355 5th Ave NE # Calgary, Alberta # T2R 0K9 # ################################################################################# use CGI qw(:standard); # Common gateway interface use CGI::Carp qw(fatalsToBrowser); # CGI Error logs use strict; # Strict variable enforcement use Webchat::Database; # Database handler use Webchat::Dbm; # DBM Addition use Webchat::Login; # Login functionality use Webchat::Param; # Parameter control use Webchat::Table; # Table handler ################################################################################# # Data Members ################################################################################# my $Database; # Database handle my $cgi; # Common gateway interface handle my %config; # Configuration hash my %param; # Parameter hash ################################################################################# # Program Area ################################################################################# $cgi = new CGI; # Create CGI Handle Webchat::Database::DatabaseConnect(\$Database); # Connect to MySQL Webchat::Param::GetParam($cgi, \%param); # Retreive parameters Webchat::Dbm::DBMOpenConfig(\%config); # Retreive configuration dbm print $cgi->header(); # File header Webchat::Database::DocumentGetHeader($Database); # HTML header if ( Webchat::Login::GetVerificationNormal($Database, $cgi, \%param) ) { if ( Supevisory($Database, \%param) ) { print "$config{'TagTitle'}\n"; # Display title # Realm selection unless (defined($param{'ROOM'})) { RealmSelect($Database, $cgi, \%param, \%config); } else { # Room information handling and display basics RoomWrite($Database, \%param, \%config); RoomView($Database, $cgi, \%param, \%config); # Bannings print "$config{'TagRealmBannings'}"; RoomBan($Database, $cgi, \%param, \%config); # Word Restrictions print "$config{'TagRealmWords'}"; RoomWord($Database, $cgi, \%param, \%config); } } } Webchat::Database::DocumentGetFooter($Database); # HTML footer Webchat::Dbm::DBMClose(\%config); # Unlink configuration dbm $Database->disconnect(); # Disconnect database handle ################################################################################# # Sub-Routines ################################################################################# ##################### # Audit Trail # # Only used for supervisors, as it was deemed that adminstrators could be trusted # and also have the access to modify results as needed. Supervisors on the other # hand should not. sub AuditTrail # Database, Parameters { ##################### # Data members my $Database = shift; # Database handle my $param = shift; # Parameter hash my $action = shift; # Action to take ##################### # Program area # Insert into audit trail $Database->do("INSERT INTO Audit VALUES (NULL,?,?, NOW())", {}, Webchat::Login::Unmangle($param->{'USER'}), $action); } # Alias for bannings # Add sub AuditTrailBanAdd { AuditTrail(shift, shift, "$_[0]: Addition of puppeteer $_[1] to the banned list..."); } # Remove sub AuditTrailBanRem { AuditTrail(shift, shift, "$_[0]: Removal of puppeteer $_[1] from the banned list..."); } # Alias for Words # Add sub AuditTrailWordAdd { AuditTrail(shift, shift, "$_[0]: Addition of word $_[1] to the word restriction list..."); } # Remove sub AuditTrailWordRem { AuditTrail(shift, shift, "$_[0]: Removal of word $_[1] from the word restriction list..."); } # Alias for Information # add sub AuditTrailInfoChange { AuditTrail(shift, shift, "$_[0]: Realm information was changed..."); } # Remove sub AuditTrailInfoReset { AuditTrail(shift, shift, "$_[0]: Realm information was reset..."); } # Alias for Realm sub AuditTrailRealm { AuditTrail(shift, shift, "$_[0]: The realms primary information was changed/updated..."); } ##################### # Realm Select # # Basic display and prompt user for a selection on which realm to adminster and # make modifications of some type to. sub RealmSelect # Database, CGI, Parameter, config { ##################### # Data members my $Database = shift; # Database handle my $cgi = shift; # CGI handle my $param = shift; # Parameter hash my $config = shift; # Config hash my @realms; # Array of realms my $realms; # Popup menu ##################### # Program area # Prepare of drop down Webchat::Database::GetListPublicRealms($Database, \@realms); $realms = $cgi->popup_menu('ROOM', \@realms); # HTML Display # Star form and top print $cgi->start_form(); # Begin form Webchat::Table::MakeTop($cgi); # Relam selection Webchat::Table::MakeValid($cgi, $config->{'TagRealmRealmSelect'}, $realms); Webchat::Table::MakeBlank($cgi); # Submit and bottom Webchat::Table::MakeSingle($cgi, $cgi->submit($config->{'TxtSubmitView'})); Webchat::Table::MakeBottom($cgi); # End of form and embed Webchat::Param::EmbedNormal($Database, $cgi, $param); # Embed parameters print $cgi->end_form(); # End form } ##################### # OptionSplit # # Splits options list into seperate elements of array sub OptionSplit { ##################### # Data members my $array = shift; # Reference to array my $data = shift; # Retreived line ##################### # Program area @{ $array } = split(/:/, $data); # Split line } ##################### # Room Ban # # Controls the bannings of certain individuals, this is realm specific. As a result # a complete ban can result in a password change that will cause the user to not be # able to log on any furthur sub RoomBan { ##################### # Data members my $Database = shift; # Database handle my $cgi = shift; # CGI handle my $param = shift; # Parameter hash my $config = shift; # Config hash my $jailbirds; # List of jailbird puppets my $suspects; # Possible suspects my $bird; # Singular bird my @banned; # List of banned puppeteers my @jailbirds; # List of jailbird puppets my @suspects; # Possible suspects ##################### # program area # Retreive list of banned and suspects Webchat::Database::GetListBanned($Database, \@banned, Webchat::Login::Unmangle($param->{'ROOM'})); Webchat::Database::GetListPuppetOther($Database, \@suspects, 'root'); # Retreive a list of all banned puppets foreach $bird (@banned) { Webchat::Database::GetListPuppetYours($Database, \@jailbirds, $bird); } # Format lists $jailbirds = $cgi->scrolling_list('BANNED', \@jailbirds, $jailbirds[0], 10); $suspects = $cgi->scrolling_list('SUSPECT', \@suspects, $suspects[0], 10); # HTML # Beginning of form print $cgi->start_form(); Webchat::Table::MakeTop($cgi); Webchat::Table::MakeValid($cgi, $jailbirds, $cgi->submit($config->{'TxtSubmitDelete'})); Webchat::Table::MakeValid($cgi, $suspects, $cgi->submit($config->{'TxtSubmitAddition'})); Webchat::Table::MakeBottom($cgi); # End of form Webchat::Param::EmbedNormal($Database, $cgi, $param); print "\t", $cgi->hidden('BAN', 'aye'), "\n"; print $cgi->end_form(); } ##################### # RoomView # # Will allow the supervisors to view the selected room and make changes as necessary # and will probably make the changes themselves. sub RoomView { ##################### # Data members my $Database = shift; # Database handle my $cgi = shift; # CGI handle my $param = shift; # Parameter hash my $config = shift; # Config hash my $access; # Access control my $language; # Language restriction my $guests; # Guests access my $tags; # Tag enforcement my @access; # Access control my @language; # Language restriction my @guests; # Guests access my @tags; # Tag enforcement my @realm; # Realm information ##################### # Program area # Data gathering and preperation # Populate option arrays OptionSplit(\@language, $config->{'OptLanugage'}); OptionSplit(\@access, $config->{'OptAccess'}); OptionSplit(\@guests, $config->{'OptGuests'}); OptionSplit(\@tags, $config->{'OptTags'}); # Populate realm information array $param->{'ROOM'} = Webchat::Login::Unmangle($param->{'ROOM'}); @realm = Webchat::Database::DataGetRealmCompleteInfo($Database, $param->{'ROOM'}); # Prepare radiobuttons $language = $cgi->radio_group('LANG', \@language, $realm[1], 'true'); $access = $cgi->radio_group('ACCESS', \@access, $realm[2], 'true'); $guests = $cgi->radio_group('GUEST', \@guests, $realm[4], 'true'); $tags = $cgi->radio_group('TAGS', \@tags, $realm[5], 'true'); # HTML display # Star form and top print $cgi->start_form(); # Begin form Webchat::Table::MakeTop($cgi); Webchat::Table::MakeSingle($cgi, "$param->{'ROOM'}"); Webchat::Table::MakeBlank($cgi); # Realm Language Webchat::Table::MakeValid($cgi, $config->{'TagRealmLanguage'}, $language); Webchat::Table::MakeBlank($cgi); # Access control Webchat::Table::MakeValid($cgi, $config->{'TagRealmAccess'}, $access); Webchat::Table::MakeBlank($cgi); # Guest access Webchat::Table::MakeValid($cgi, $config->{'TagRealmGuests'}, $guests); Webchat::Table::MakeBlank($cgi); # Realm tag control Webchat::Table::MakeValid($cgi, $config->{'TagRealmTags'}, $tags); Webchat::Table::MakeBlank($cgi); Webchat::Table::MakeBlank($cgi); # Image restriction Webchat::Table::MakeValid($cgi, $config->{'TagPupImgHeight'}, $cgi->textfield('IMGHEIGHT', $realm[10], 3, 3)); Webchat::Table::MakeValid($cgi, $config->{'TagPupImgWidth'}, $cgi->textfield('IMGWIDTH', $realm[11], 3, 3)); Webchat::Table::MakeBlank($cgi); # Realm info Webchat::Table::MakeSingle($cgi, $config->{'TagRealmInfo'}); Webchat::Table::MakeSingle($cgi, $cgi->textarea('INFO', $realm[6], 10, 70)); Webchat::Table::MakeBlank($cgi); # Submit and bottom Webchat::Table::MakeValid($cgi, $cgi->submit($config->{'TxtSubmitButton'}), $cgi->submit($config->{'TxtResetButton'})); Webchat::Table::MakeBottom($cgi); # End of form and embed Webchat::Param::EmbedNormal($Database, $cgi, $param); # Embed parameters print "\t", $cgi->hidden('MAIN', 'aye'), "\n"; print $cgi->end_form(); # End form } ##################### # Room Word # # Controls word restrictions, as a result one can add or remove words for which # such words will be replaced from posts by ****. Simplistic but effective. sub RoomWord { ##################### # Data members my $Database = shift; # Database handle my $cgi = shift; # CGI handle my $param = shift; # Parameter hash my $config = shift; # Config hash my $words; # List of words my @words; # List of words ##################### # program area # Retreive list of banned and suspects Webchat::Database::GetListWords($Database, \@words, Webchat::Login::Unmangle($param->{'ROOM'})); $words = $cgi->scrolling_list('WORDREM', \@words, $words[0], 10); # HTML # Beginning of form print $cgi->start_form(); Webchat::Table::MakeTop($cgi); Webchat::Table::MakeValid($cgi, $words, $cgi->submit($config->{'TxtSubmitDelete'})); Webchat::Table::MakeValid($cgi, $cgi->textfield('WORDADD', '', 10, 10), $cgi->submit($config->{'TxtSubmitAddition'})); Webchat::Table::MakeBottom($cgi); # End of form Webchat::Param::EmbedNormal($Database, $cgi, $param); print "\t", $cgi->hidden('WORDS', 'aye'), "\n"; print $cgi->end_form(), "\n"; } ##################### # Room Write # # Will handle the writing of information gathered from the forms. sub RoomWrite { ##################### # Data members my $Database = shift; # Database handle my $param = shift; # Parameter hash my $config = shift; # Config hash my $puppeteer; # Puppeteers name ##################### # Program area # Unmangle room $param->{'ROOM'} = Webchat::Login::Unmangle($param->{'ROOM'}); # Word restrictions if (defined($param->{'WORDS'})) { # Removal if (defined($param->{"$config->{'TxtSubmitDelete'}"})) { $Database->do("DELETE FROM WordRestriction WHERE RealmName=? AND WordSpelling=?", {}, $param->{'ROOM'}, $param->{'WORDREM'}); AuditTrailWordRem($Database, $param, $param->{'ROOM'}, $param->{'WORDREM'}); } # Addition elsif (defined($param->{"$config->{'TxtSubmitAddition'}"})) { $Database->do("INSERT INTO WordRestriction VALUES (?,?)", {}, $param->{'WORDADD'}, $param->{'ROOM'}); AuditTrailWordAdd($Database, $param, $param->{'ROOM'}, $param->{'WORDADD'}); } } # For banning handling # Removal of person elsif (defined($param->{'BAN'})) { if (defined($param->{"$config->{'TxtSubmitDelete'}"})) { # Retreive and remove puppeteer from banned list ($puppeteer) = Webchat::Database::DataGetPuppeteerLogin($Database, Webchat::Login::Unmangle($param->{'BANNED'})); $Database->do("DELETE FROM PuppeteerRestriction WHERE PuppeteerLogin=?", {}, $puppeteer); AuditTrailBanRem($Database, $param, $param->{'ROOM'}, $puppeteer); } # Addition elsif (defined($param->{"$config->{'TxtSubmitAddition'}"})) { # Retreive and remove puppeteer from banned list ($puppeteer) = Webchat::Database::DataGetPuppeteerLogin($Database, Webchat::Login::Unmangle($param->{'SUSPECT'})); $Database->do("INSERT INTO PuppeteerRestriction VALUES (?,?,?)", {}, $puppeteer, $param->{'ROOM'}, time); AuditTrailBanAdd($Database, $param, $param->{'ROOM'}, $puppeteer); } } # Update main information elsif (defined($param->{'MAIN'})) { # Update primary information $Database->do("UPDATE Realm SET RealmLanguage=?, RealmAccess=?, RealmGuests=?, RealmTags=?, RealmImageHeight=?, RealmImageWidth=? WHERE RealmName=?", {}, $param->{'LANG'}, $param->{'ACCESS'}, $param->{'GUEST'}, $param->{'TAGS'}, $param->{'IMGHEIGHT'}, $param->{'IMGWIDTH'}, $param->{'ROOM'}); AuditTrailRealm($Database, $param, $param->{'ROOM'}); # Realm Information if (($param->{'INFO'} =~ tr/a-zA-Z0-9\:\///) > 4) { # Enter information $Database->do("UPDATE Realm SET RealmInfo=? WHERE RealmName=?", {}, $param->{'INFO'}, $param->{'ROOM'}); AuditTrailInfoChange($Database, $param, $param->{'ROOM'}); } else { # Reset to null $Database->do("UPDATE Realm SET RealmInfo=NULL WHERE RealmName=?", {}, $param->{'ROOM'}); AuditTrailInfoReset($Database, $param, $param->{'ROOM'}); } } } ##################### # Supervisory # # Will only allow people to see information if they have supervisory access to # the system. sub Supevisory { ##################### # Data members my $Database = shift; # Database handle my $param = shift; # Parameter hash my $super; # Supervisor privs ##################### # Program area # Unmangle username $param->{'USER'} = Webchat::Login::Unmangle($param->{'USER'}); # Retreive supervisor information ($super) = Webchat::Database::DataGetSupervisor($Database, $param->{'USER'}); # Return true if ues if ($super eq 'yes') { return 1; } # Otherwise fall back on no return 0; } ethereal-1.0.0/config/config-puppeteer.plx100755 0 0 23141 7053646576 16674 0ustar rootroot#!/bin/perl ################################################################################# # Created : Martin Foster # Modified : 01/20/2000 ################################################################################# # # Configure Puppeteer - Script part of Webchat designed to configure Puppeteers # Copyright (C) 2000 Martin Foster # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # # Author of this script can be contacted at the following: # E-Mail : mfoster@redwhite.com # Address : Suite 209 - 355 5th Ave NE # Calgary, Alberta # T2R 0K9 # ################################################################################# use CGI qw(:standard); # Common gateway interface use CGI::Carp qw(fatalsToBrowser); # CGI Error logs use strict; # Strict variable enforcement use String::Random; # Random String generator use Webchat::Database; # Database handler use Webchat::Dbm; # DBM Addition use Webchat::Login; # Login functionality use Webchat::Param; # Parameter control use Webchat::Table; # Table control ################################################################################# # Data Members ################################################################################# my $Database; # Database handle my $cgi; # Common gateway interface handle my %param; # Parameter hash my %config; # Configuration tag ################################################################################# # Program Area ################################################################################# $cgi = new CGI; # Create CGI Handle Webchat::Database::DatabaseConnect(\$Database); # Connect to MySQL Webchat::Param::GetParam($cgi, \%param); # Retreive parameters Webchat::Dbm::DBMOpenConfig(\%config); # Attach hash print $cgi->header(); # File header Webchat::Database::DocumentGetHeader($Database); # HTML header # Authenthication if ( Webchat::Login::GetVerificationNormal($Database, $cgi, \%param) ) { print "$config{'TagTitle'}\n
\n"; # Print title # Initial screen unless ( defined($param{'OLDPASS'}) || defined($param{'EMAIL'})) { InitialDisplay($Database, $cgi, \%param); } # Information handling else { InformationHandler($Database, $cgi, \%param); } } Webchat::Database::DocumentGetFooter($Database); # HTML footer Webchat::Dbm::DBMClose(\%config); # Release hash $Database->disconnect(); # Disconnect database handle ################################################################################# # Sub-Routines ################################################################################# ##################### # Check Data # # Arbitrary sub-routine designed to be used to check validity of data. Made # to hide ugliness of checks also centralize adapting of checks. sub CheckData # Check value, $choice, Database, User { ##################### # Data members my $value = shift; # Value to check my $choice = shift; # Choice of the matter my $Database = shift; # Possible database handle my $Statement; # SQL Statement my $user = shift; # User ##################### # Program area # Password Check if ($choice == 0) { $user = Webchat::Login::Unmangle($user); # Unmange username # Prepare and execute $Statement = $Database->prepare("SELECT PuppeteerPassword FROM Puppeteer WHERE PuppeteerLogin=?"); $Statement->execute($user); # Retreive and finish my $crypt = $Statement->fetchrow(); $Statement->finish(); # Verify existence of user and validity of password if ( ( defined($crypt) ) && ( $crypt eq crypt($value, $crypt) ) ) { return 1; } # Return true } # Lenght elsif ($choice == 1) { # Lenght of a minumum of 5 characters if (($value =~ tr/a-zA-Z0-9@.\///) > 3) { return 1; } # Return true } # E-Mail elsif ($choice == 2) { # Check for @ and . lenght if ( ($value =~ /\@/) && ($value =~ /\./) && (($value =~ tr/a-zA-Z0-9@.\///) > 5) ) { return 1; } # Return true } return 0; # False if all else fails } # Alias for Password validity sub CheckDataPassword { CheckData($_[2], 0, $_[0], $_[1]); } # Alias for Lenght sub CheckDataLenght { CheckData(shift, 1); } # Alias for E-Eail validity sub CheckDataEMail { CheckData(shift, 1); } ##################### # Information Handler # # Will take the parameters and depending on information received can change the # passwords and email. The rest is considered non-essential. sub InformationHandler # Database, CGI, Param { ##################### # Data members my $Database = shift; # Database handle my $cgi = shift; # CGI handle my $param = shift; # Parameter handle my $choice = 0; # Choice of action my %config; # Configuration hash ##################### # Program area # Link DBM with hash Webchat::Dbm::DBMOpenConfig(\%config); # Display of information print $cgi->start_form(); Webchat::Table::MakeTop($cgi); # Primary security check # Password Validity if ( CheckDataPassword($Database, $param->{'USER'}, $param->{'OLDPASS'}) ) { $choice++; } # Increment by one else { Webchat::Table::MakeSingle($cgi, $cgi->h1("
$config{'ErrPassword'}
")); } # Password change if ( defined($param->{'ONEPASS'}) ) { # Valid new passwords if ( (CheckDataLenght($param->{'ONEPASS'})) && ($param->{'ONEPASS'} eq $param->{'TWOPASS'}) ) { $choice++; } # Inrement by one else { Webchat::Table::MakeSingle($cgi, $cgi->h1("
$config{'ErrMismatch'}
")); } } # E-Mail change elsif ( defined($param->{'EMAIL'}) ) { # Valid new E-Mail if ( CheckDataEMail($param->{'EMAIL'}) ) { $choice++; } # Inrement by one else { Webchat::Table::MakeSingle($cgi, $cgi->h1("
$config{'ErrEMail'}
")); } } # If both tests pass, change data if ($choice == 2) { # Unmangle string $param->{'USER'} = Webchat::Login::Unmangle($param->{'USER'}); # Password change if ( defined($param->{'ONEPASS'}) ) { # Create random string generator my $rand = new String::Random; # Insert new password $Database->do("UPDATE Puppeteer SET PuppeteerPassword=? WHERE PuppeteerLogin=?", {}, crypt($param->{'ONEPASS'}, $rand->randpattern("ssssssss")), $param->{'USER'} ); } # EMail change elsif ( defined($param->{'EMAIL'}) ) { # Insert new password $Database->do("UPDATE Puppeteer SET PuppeteerEMail=? WHERE PuppeteerLogin=?", {}, $param->{'EMAIL'}, $param->{'USER'}); } # Congratulations message Webchat::Table::MakeSingle($cgi, $cgi->h1("
$config{'TagConfSuccess'}
")); } # Table bottom Webchat::Table::MakeBottom($cgi); # Free DBMs from hashes Webchat::Dbm::DBMClose(\%config); } ##################### # InitialDisplay # # Handles the general output of the initial display screen. Which will allow one # to change password, E-Mail addresses and/or passwords. sub InitialDisplay # Database, CGI, Param { ##################### # Data members my $Database = shift; # Database handle my $cgi = shift; # CGI handle my $param = shift; # Parameter handle my %login; # Login hash my %config; # Config hash ##################### # Program area # Link DBMs with hashes Webchat::Dbm::DBMOpenLogin(\%login); Webchat::Dbm::DBMOpenConfig(\%config); # Password change # Display of information print $cgi->start_form(); # Top HTML Webchat::Table::MakeTop($cgi); Webchat::Table::MakeSingle($cgi, $config{'TagConfPassword'}); Webchat::Table::MakeBlank($cgi); # Password section Webchat::Table::MakeValid($cgi, $login{'TagPasswordOld'}, $cgi->password_field('OLDPASS', '', 10, 8)); Webchat::Table::MakeValid($cgi, $login{'TagPassword'}, $cgi->password_field('ONEPASS', '', 10, 8)); Webchat::Table::MakeValid($cgi, $login{'TagPasswordRepeat'}, $cgi->password_field('TWOPASS', '', 10, 8)); Webchat::Table::MakeBlank($cgi); # Submit and bottom Webchat::Table::MakeValid($cgi, $cgi->submit( $login{'TxtSubmitButtonSub'} ), $cgi->reset( $login{'TxtResetButton'} )); Webchat::Table::MakeBottom($cgi); # Embed Webchat::Param::EmbedNormal($Database, $cgi, $param); print $cgi->end_form(), "\n"; # Spacing print "
\n
\n"; # Email change # Display of information print $cgi->start_form(); Webchat::Table::MakeTop($cgi); Webchat::Table::MakeSingle($cgi, $config{'TagConfEMail'}); Webchat::Table::MakeBlank($cgi); # Email section Webchat::Table::MakeValid($cgi, $login{'TagPassword'}, $cgi->password_field('OLDPASS', '', 10, 8)); Webchat::Table::MakeValid($cgi, $login{'TagEMail'}, $cgi->textfield('EMAIL', '', 20, 45)); Webchat::Table::MakeBlank($cgi); # Submit and bottom Webchat::Table::MakeValid($cgi, $cgi->submit( $login{'TxtSubmitButtonSub'} ), $cgi->reset( $login{'TxtResetButton'} )); Webchat::Table::MakeBottom($cgi); # Embed Webchat::Param::EmbedNormal($Database, $cgi, $param); print $cgi->end_form(), "\n"; # Free DBM and hash Webchat::Dbm::DBMClose(\%login); Webchat::Dbm::DBMClose(\%config); } ethereal-1.0.0/config/config-ignore.plx100755 0 0 12504 7053646576 16147 0ustar rootroot#!/bin/perl ################################################################################# # Created : Martin Foster # Modified : 01/20/2000 ################################################################################# # # Configure Ignore - Script part of Webchat designed to configure ignore lists # Copyright (C) 2000 Martin Foster # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # # Author of this script can be contacted at the following: # E-Mail : mfoster@redwhite.com # Address : Suite 209 - 355 5th Ave NE # Calgary, Alberta # T2R 0K9 # ################################################################################# use CGI qw(:standard); # Common gateway interface use CGI::Carp qw(fatalsToBrowser); # CGI Error logs use strict; # Strict variable enforcement use String::Random; # Random String generator use Webchat::Database; # Database handler use Webchat::Dbm; # DBM Addition use Webchat::Login; # Login functionality use Webchat::Param; # Parameter control use Webchat::Table; # Table control ################################################################################# # Data Members ################################################################################# my $Database; # Database handle my $cgi; # Common gateway interface handle my %param; # Parameter hash my %config; # Configuration tag ################################################################################# # Program Area ################################################################################# $cgi = new CGI; # Create CGI Handle Webchat::Database::DatabaseConnect(\$Database); # Connect to MySQL Webchat::Param::GetParam($cgi, \%param); # Retreive parameters Webchat::Dbm::DBMOpenConfig(\%config); # Attach hash print $cgi->header(); # File header Webchat::Database::DocumentGetHeader($Database); # HTML header # Authenthication if ( Webchat::Login::GetVerificationNormal($Database, $cgi, \%param) ) { print "$config{'TagTitle'}\n
\n"; # Print title InitialDisplay($Database, $cgi, \%param); } Webchat::Database::DocumentGetFooter($Database); # HTML footer Webchat::Dbm::DBMClose(\%config); # Release hash $Database->disconnect(); # Disconnect database handle ################################################################################# # Sub-Routines ################################################################################# ##################### # InitialDisplay # # Handles the general output of the initial display screen. Which will allow one # to change password, E-Mail addresses and/or passwords. sub InitialDisplay # Database, CGI, Param { ##################### # Data members my $Database = shift; # Database handle my $cgi = shift; # CGI handle my $param = shift; # Parameter handle my %config; # Config hash my $puppets; # List of puppets my $ignored; # List of the dammed my @puppets; # List of puppets my @ignored; # List of the dammed ##################### # Program area # Link DBMs with hashes Webchat::Dbm::DBMOpenConfig(\%config); # Information handling # Addition into list if (defined($param->{$config{'TxtSubmitAddition'}})) { # Insert information $Database->do("INSERT INTO PuppetIgnore VALUES (?,?)", {}, Webchat::Login::Unmangle($param->{'USER'}), $param->{'LIST'}); } # Removal from list elsif (defined($param->{$config{'TxtSubmitDelete'}})) { # Remove ignored person $Database->do("DELETE FROM PuppetIgnore WHERE PuppeteerLogin=? AND PuppetName=?", {}, Webchat::Login::Unmangle($param->{'USER'}), $param->{'IGNORE'}); } # Retreive lists Webchat::Database::GetListPuppetOther($Database, \@puppets, Webchat::Login::Unmangle($param->{'USER'})); Webchat::Database::GetListPuppetIgnored($Database, \@ignored, Webchat::Login::Unmangle($param->{'USER'})); # Confihure widgets $puppets = $cgi->scrolling_list('LIST', \@puppets, $puppets[0], 10); $ignored = $cgi->scrolling_list('IGNORE', \@ignored, $ignored[0], 10); # Ignore list # Display of information print $cgi->start_form(); Webchat::Table::MakeTop($cgi); Webchat::Table::MakeSingle($cgi, $config{'TagConfIgnore'}); Webchat::Table::MakeBlank($cgi); # Additions and removal control Webchat::Table::MakeValid($cgi, $puppets, $cgi->submit($config{'TxtSubmitAddition'})); Webchat::Table::MakeBlank($cgi); Webchat::Table::MakeValid($cgi, $ignored, $cgi->submit($config{'TxtSubmitDelete'})); Webchat::Table::MakeBottom($cgi); # Embed Webchat::Param::EmbedNormal($Database, $cgi, $param); print $cgi->end_form(), "\n"; # Free DBM and hash Webchat::Dbm::DBMClose(\%config); } ethereal-1.0.0/post/ 40755 0 0 0 7053646576 12272 5ustar rootrootethereal-1.0.0/post/private.plx100755 0 0 15663 7053646576 14624 0ustar rootroot#!/bin/perl ################################################################################# # Created : Martin Foster # Modified : 01/30/2000 ################################################################################# # # Realm - Script part of Webchat designed to use the realms # Copyright (C) 2000 Martin Foster # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # # Author of this script can be contacted at the following: # E-Mail : mfoster@redwhite.com # Address : Suite 209 - 355 5th Ave NE # Calgary, Alberta # T2R 0K9 # ################################################################################# use CGI qw(:standard); # Common gateway interface use CGI::Carp qw(fatalsToBrowser); # CGI Error logs use strict; # Strict variable enforcement use Webchat::Comm; # Communication handler use Webchat::Database; # Database handler use Webchat::Dbm; # DBM Addition use Webchat::Login; # Login functionality use Webchat::Param; # Parameter control use Webchat::Table; # Table handler ################################################################################# # Data Members ################################################################################# my $Database; # Database handle my $cgi; # Common gateway interface handle my %param; # Parameter hash ################################################################################# # Program Area ################################################################################# $cgi = new CGI; # Create CGI Handle Webchat::Database::DatabaseConnect(\$Database); # Connect to MySQL Webchat::Param::GetParam($cgi, \%param); # Retreive parameters print $cgi->header(); # File header Webchat::Database::DocumentGetHeader($Database); # HTML header if ( Webchat::Login::GetVerificationNormal($Database, $cgi, \%param) ) { TargetHandler($Database, \%param); Webchat::Comm::DataWrite($Database, \%param); DisplayHandler($Database, $cgi, \%param); } Webchat::Database::DocumentGetFooter($Database); # HTML footer $Database->disconnect(); # Disconnect database handle ################################################################################# # Sub-Routines ################################################################################# #################### # Display Handler # # Display prompt for a private message, this includes a list of all the puppets # et cetera. sub DisplayHandler # Database, Cgi, Param { #################### # Data members my $Database = shift; # Database handle my $cgi = shift; # Cgi handle my $param = shift; # Parameter handle my $who; # List of puppets my $char; # List of characters my $color; # Colour choices my $size; # Text colour my $defsize; # Default size my $defcolor; # Default colour my $delay; # Delay of time my @who; # List of puppets my @char; # List of characters my @color; # Colour choices my @size; # Text colour my %chat; # Chat hash my %realm; # Realm DBM #################### # Program area # Link DBM with hash Webchat::Dbm::DBMOpenChat(\%chat); Webchat::Dbm::DBMOpenRealm(\%realm); # Calculate delay $delay = (time - $realm{'SetTimeout'}); # Unmangle data $param->{'USER'} = Webchat::Login::Unmangle($param->{'USER'}); $param->{'CHAR'} = Webchat::Login::Unmangle($param->{'CHAR'}); $param->{'ROOM'} = Webchat::Login::Unmangle($param->{'ROOM'}); # Populate arrays OptionSplit(\@color, $chat{'OptTextColour'}); OptionSplit(\@size, $chat{'OptTextSize'}); Webchat::Database::GetListPuppetYours($Database, \@char, $param->{'USER'}); Webchat::Database::GetListWho($Database, \@who, $param->{'ROOM'}, $delay); # Retreive size and color ($defsize, $defcolor) = Webchat::Database::DataGetFont($Database, $param->{'CHAR'}, $color[0]); # Format buttons $who = $cgi->scrolling_list('TARGET', \@who, $who[0], 5); $char = $cgi->popup_menu('CHAR', \@char, $param->{'CHAR'}); $color = $cgi->popup_menu('COLOR', \@color, $defcolor); $size = $cgi->popup_menu('SIZE', \@size, $defsize); # HTML # Top and title print $cgi->start_form(); Webchat::Table::MakeTop($cgi); Webchat::Table::MakeSingle($cgi, $chat{'SetTop'}); # Prompt and space Webchat::Table::MakeSingle($cgi, ''); Webchat::Table::MakeBlank($cgi); # Prompt for From, To, Colour, Puppet Webchat::Table::MakeValid($cgi, $chat{'TagPuppet'}, $char); Webchat::Table::MakeValid($cgi, $chat{'TagPuppetTo'}, $who); Webchat::Table::MakeValid($cgi, $chat{'TagTextColour'}, $color); Webchat::Table::MakeValid($cgi, $chat{'TagTextSize'}, $size); Webchat::Table::MakeBlank($cgi); # Submit Button Webchat::Table::MakeSingle($cgi, $cgi->submit($chat{'TxtSubmitButton'})); # Bottom and end form Webchat::Table::MakeBottom($cgi); Webchat::Param::EmbedNormal($Database, $cgi, $param); print $cgi->end_form(); # Unlink DBM with hash Webchat::Dbm::DBMClose(\%chat); Webchat::Dbm::DBMClose(\%realm); } ##################### # OptionSplit # # Splits options list into seperate elements of array sub OptionSplit { ##################### # Data members my $array = shift; # Reference to array my $data = shift; # Retreived line ##################### # Program area @{ $array } = split(/:/, $data); # Split line } ##################### # Target Handler # # Will determine target to send the message privately to. This will also create a # parameter called SOURCE which will receive a copy as well. sub TargetHandler { ##################### # Data members my $Database = shift; # Database handle my $Statement; # Database statement my $param = shift; # Parameter handle my $puppeteer; # Puppeteer to send to ##################### # Program area # Only do changes if target exists if (defined($param->{'TARGET'})) { # Unmangle names $param->{'TARGET'} = Webchat::Login::Unmangle($param->{'TARGET'}); $param->{'USER'} = Webchat::Login::Unmangle($param->{'USER'}); # Retreive puppeteer name ($puppeteer) = Webchat::Database::DataGetPuppeteerLogin($Database, $param->{'TARGET'}); # Assign values to parameters $param->{'TARGET'} = $puppeteer; $param->{'SOURCE'} = $param->{'USER'}; } } ethereal-1.0.0/post/who.plx100755 0 0 5554 7053646576 13725 0ustar rootroot#!/bin/perl ################################################################################# # Created : Martin Foster # Modified : 01/29/2000 ################################################################################# # # Who - Script part of Webchat designed to list who is currently on # Copyright (C) 2000 Martin Foster # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # # Author of this script can be contacted at the following: # E-Mail : mfoster@redwhite.com # Address : Suite 209 - 355 5th Ave NE # Calgary, Alberta # T2R 0K9 # ################################################################################# use CGI qw(:standard); # Common gateway interface use CGI::Carp qw(fatalsToBrowser); # CGI Error logs use strict; # Strict variable enforcement use Webchat::Database; # Database handler use Webchat::Dbm; # DBM Addition use Webchat::Login; # Login functionality use Webchat::Param; # Parameter control use Webchat::Who; # Who is on ################################################################################# # Data Members ################################################################################# my $Database; # Database handle my $cgi; # Common gateway interface handle my %param; # Parameter hash my %realm; # Realm hash ################################################################################# # Program Area ################################################################################# $cgi = new CGI; # Create CGI Handle Webchat::Database::DatabaseConnect(\$Database); # Connect to MySQL Webchat::Param::GetParam($cgi, \%param); # Retreive parameters print $cgi->header(); # File header Webchat::Database::DocumentGetHeader($Database); # HTML header if ( Webchat::Login::GetVerificationNormal($Database, $cgi, \%param) ) { # Display title Webchat::Dbm::DBMOpenRealm(\%realm); print "$realm{'TagTitleWho'}\n
\n"; Webchat::Dbm::DBMClose(\%realm); # Display who is on Webchat::Who::WhoNormal($Database, $cgi, \%param); } Webchat::Database::DocumentGetFooter($Database); # HTML footer $Database->disconnect(); # Disconnect database handle ethereal-1.0.0/registration.plx100755 0 0 43766 7053646576 14704 0ustar rootroot#!/bin/perl -w ################################################################################# # Created : Martin Foster # Modified : 01/12/2000 ################################################################################# # # Puppeteer Registration - Script part of Webchat designed to register patrons # Copyright (C) 2000 Martin Foster # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # # Author of this script can be contacted at the following: # E-Mail : mfoster@redwhite.com # Address : Suite 209 - 355 5th Ave NE # Calgary, Alberta # T2R 0K9 # ################################################################################# use CGI qw(:standard); # Common gateway interface use CGI::Carp qw(fatalsToBrowser); # CGI Error logs use strict; # Strict variable enforcement use String::Random; # Random string generator use Webchat::Database; # Database handler use Webchat::Dbm; # DBM Addition use Webchat::Login; # Login functionality use Webchat::Param; # Parameter control use Webchat::Table; # Table module ################################################################################# # Data Members ################################################################################# my $Database; # Database handle my $cgi; # Common gateway interface handle my $capture; # Arbitrary captured line my %login; # Login hash my %system; # System hash my %param; # Parameter hash ################################################################################# # Program Area ################################################################################# Webchat::Database::DatabaseConnect(\$Database); # Connect to MySQL $cgi = new CGI; # Create CGI Handle print $cgi->header(); # File header Webchat::Database::DocumentGetHeader($Database); # HTML Header unless ($cgi->param()) # Entrance without parameters { InformationFormInit($cgi, \%param); # Initial form } else # Entrace with parameters { Webchat::Param::GetParam($cgi, \%param); # Retreive parameters # If no registration codes or logins unless ((defined($param{'LOGIN'})) && (defined($param{'CONFCODE'}))) { # If not accepted show AUP unless (defined($param{'ACCEPT'})) { # Check contrains if correct then print AUP if (ConstraintHandler($Database, $cgi, \%param)) { PolicyForm($Database, $cgi, \%param); } } # If accepted process request elsif (defined($param{'ACCEPT'})) { RequestHandler($Database, \%param); } } # If such a code was sent else { # Check if registration is valid if (AcceptHandler($Database, \%param)) { Webchat::Database::DocumentGetAccepted($Database); } # If not send initial form else { InformationFormInit($cgi, \%param); } } } Webchat::Database::DocumentGetFooter($Database); # HTML footer $Database->disconnect(); # Disconnect from database ################################################################################# # Sub-Routines ################################################################################# ##################### # Acceptence Handler # # Will determine is registration code is correct. If so, the script will remove # registration information allowing user to login as needed. sub AcceptHandler # Database, Param reference { ##################### # Data members my $Database = shift; # Database handle my $Statement; # Statement handle my $param = shift; # Parameter list my $capture; # Captured data ##################### # Program area # Change underscores to spaces $param->{'LOGIN'} = Webchat::Login::Unmangle($param->{'LOGIN'}); # Prepare and execute statement $Statement = $Database->prepare("SELECT PuppeteerLogin FROM PuppeteerRegistration WHERE PuppeteerLogin=? AND PuppeteerConfCode=?"); $Statement->execute($param->{'LOGIN'}, $param->{'CONFCODE'}); # Capture and finish statement $capture = $Statement->fetchrow(); $Statement->finish; # If entry was found if (defined($capture)) { # Erase lock $Database->do("DELETE FROM PuppeteerRegistration WHERE PuppeteerLogin=? AND PuppeteerConfCode=?", {}, $param->{'LOGIN'}, $param->{'CONFCODE'}); # Return true return 1; } return 0; } ##################### # Check Parameter # # Checks parameters and verifies if data exists already in table or if they # fit criteria. sub CheckParam { ##################### # Data members my $subject = shift; # Arbitrary retrieval my $choice = shift; # Choice on the matter my $check = shift; # Check value ##################### # Program area # Lenght if ($choice == 0) { if (($subject =~ tr/a-zA-Z0-9.\///) < 5) { return 0; } # False if password short return 1; # Return true if 5 or more } # E-Mail if ($choice == 1) { if ($subject !~ /\@/) { return 0; } # False if password short return 1; # Return true if 5 or more } # Login name availability elsif ($choice == 2) { # Initialize and execute statement my $Statement = $subject->prepare("SELECT PuppeteerLogin FROM Puppeteer WHERE PuppeteerLogin=?"); $Statement->execute($check); # Retreive information and finish $choice = $Statement->fetchrow(); $Statement->finish; # Verify fate if (defined($choice)) # Return false if not found { return 0; } return 1; # Return true if not found } } # Alias for Lenght sub CheckParamLenght { return CheckParam(shift, 0); } # Alias for Email sub CheckParamEmail { return CheckParam(shift, 1); } # Alias for Login sub CheckParamLogin { return CheckParam(shift, 2, shift); } ##################### # Constrain Handler # # Checks contrains, if they are correct returns true, otherwise requests # repost of data missing or off. sub ConstraintHandler # Database, CGI, Parameter Reference { ##################### # Data members my $Database = shift; # Database handle my $cgi = shift; # CGI handle my $param = shift; # Parameter reference ##################### # Program area # Username/login verfication unless ((CheckParamLogin($Database, $param->{'USERNAME'})) && (CheckParamLenght($param->{'USERNAME'}))) { InformationFormLogin($cgi, $param); return 0;} # Return false # Full name verification unless (CheckParamLenght($param->{'FULLNAME'})) { InformationFormFullname($cgi, $param); return 0;} # Return false # EMail check unless ((CheckParamLenght($param->{'EMAIL'})) && (CheckParamEmail($param->{'EMAIL'}))) { InformationFormEmail($cgi, $param); return 0;} # Return false # Password verification unless (($param->{'PASSONCE'} eq $param->{'PASSTWICE'}) && (CheckParamLenght($param->{'PASSONCE'}))) { InformationFormPassword($cgi, $param); return 0;} # Return false return 1; } ##################### # Information Form # # Initially displayed sub-routine, for sole purpose of gathering infromation. sub InformationForm { ##################### # Data members my $cgi = shift; # CGI handle my $param = shift; # Parameter handling my $choice = shift; # Choice of the matter my %login; # Login hash my %system; # System hash my @javascript; # Javascript prefs array my @chatpref; # Chat prefs array my @formatting; # Formatting options my $javascript; # Javascript option my $chatpref; # Chatpref option my $formatting; # Formatting option ##################### # Program area # Associate hashes with DBM Webchat::Dbm::DBMOpenLogin(\%login); Webchat::Dbm::DBMOpenSystem(\%system); # Retreive arrays with necessary options OptionSplit(\@javascript, $login{'OptJavascript'}); OptionSplit(\@chatpref, $login{'OptChatPref'}); OptionSplit(\@formatting, $login{'OptFormat'}); Webchat::Database::DocumentGetRegistration($Database); # Information on registration print $cgi->start_form; # Begin form Webchat::Table::MakeTop($cgi); # Main information # Username if ($choice == 99) # Initial { Webchat::Table::MakeValid($cgi, $login{'TagUsername'}, $cgi->textfield('USERNAME', '', 10, 10)); } elsif ($choice == 0) # Invalid { Webchat::Table::MakeInvalid($cgi, $login{'TagUsername'}, $cgi->textfield('USERNAME', '', 10, 10)); } else # Valid repeat { Webchat::Table::MakeValid($cgi, $login{'TagUsername'}, $cgi->textfield('USERNAME', $param->{'USERNAME'}, 10, 10)); } # Fullname if ($choice == 99) # Initial { Webchat::Table::MakeValid($cgi, $login{'TagFullName'}, $cgi->textfield('FULLNAME', '', 20, 30)); } elsif ($choice == 1) # Invalid { Webchat::Table::MakeInvalid($cgi, $login{'TagFullName'}, $cgi->textfield('FULLNAME', '', 20, 30)); } else # Valid repeat { Webchat::Table::MakeValid($cgi, $login{'TagFullName'}, $cgi->textfield('FULLNAME', $param->{'FULLNAME'}, 20, 30)); } # EMail if ($choice == 99) # Initial { Webchat::Table::MakeValid($cgi, $login{'TagEMail'}, $cgi->textfield('EMAIL', '', 20, 45)); } elsif ($choice == 2) # Invalid { Webchat::Table::MakeInvalid($cgi, $login{'TagEMail'}, $cgi->textfield('EMAIL', '', 20, 45)); } else { Webchat::Table::MakeValid($cgi, $login{'TagEMail'}, $cgi->textfield('EMAIL', $param->{'EMAIL'}, 20, 45)); } Webchat::Table::MakeBlank($cgi); # Spacer # Password information if ($choice == 99) # Initial { Webchat::Table::MakeValid($cgi, $login{'TagPassword'}, $cgi->password_field('PASSONCE', '', 10, 8)); Webchat::Table::MakeValid($cgi, $login{'TagPasswordRepeat'}, $cgi->password_field('PASSTWICE', '', 10, 8)); } elsif ($choice == 3) # Invalid { Webchat::Table::MakeInvalid($cgi, $login{'TagPassword'}, $cgi->password_field('PASSONCE', '', 10, 8)); Webchat::Table::MakeInvalid($cgi, $login{'TagPasswordRepeat'}, $cgi->password_field('PASSTWICE', '', 10, 8)); } else # Valid Repeat { Webchat::Table::MakeValid($cgi, $login{'TagPassword'}, $cgi->password_field('PASSONCE', $param->{'PASSONCE'}, 10, 8)); Webchat::Table::MakeValid($cgi, $login{'TagPasswordRepeat'}, $cgi->password_field('PASSTWICE', $param->{'PASSTWICE'}, 10, 8)); } Webchat::Table::MakeBlank($cgi); # Spacer # Initialize Javascript and Chat preferences $javascript = $cgi->radio_group('JAVASCRIPT', \@javascript, $javascript[0],'true'); $chatpref = $cgi->radio_group('CHATPREFS', \@chatpref, $chatpref[0],'true'); $formatting = $cgi->radio_group('FORMATPREFS', \@formatting, $formatting[0],'true'); # Javascript options Webchat::Table::MakeValid($cgi, $login{'TagOptJavacript'}, $javascript); Webchat::Table::MakeBlank($cgi); # Spacer # Chat preferences Webchat::Table::MakeValid($cgi, $login{'TagOptChatPref'}, $chatpref); Webchat::Table::MakeBlank($cgi); # Spacer # Formatting preferences Webchat::Table::MakeValid($cgi, $login{'TagOptFormat'}, $formatting); Webchat::Table::MakeBlank($cgi); # Spacer # Submission Webchat::Table::MakeValid($cgi, $cgi->submit($login{'TxtSubmitButtonSub'}), $cgi->reset($login{'TxtResetButton'})); Webchat::Table::MakeBottom($cgi); print $cgi->end_form; # End form # Disassociate hashes with DBM Webchat::Dbm::DBMClose(\%login); Webchat::Dbm::DBMClose(\%system); } # Alias for Initilization sub InformationFormInit { InformationForm(shift, shift, 99); } # Alias for Login sub InformationFormLogin { InformationForm(shift, shift, 0); } # Alias for Fullname sub InformationFormFullname { InformationForm(shift, shift, 1); } # Alias for EMail sub InformationFormEmail { InformationForm(shift, shift, 2); } # Alias for pasword sub InformationFormPassword { InformationForm(shift, shift, 3); } ##################### # Policy Form # # Displayes the acceptable use policy flag and embeds all information gathered. # Also adds a tag to mark acceptance. sub PolicyForm # Database, CGI, Parameter hash { ##################### # Data members my $Database = shift; # Database handle my $cgi = shift; # Common gateway interface my $param = shift; # Parameter my $single; # Single unit my %login; # Login hash dbm ##################### # Program area Webchat::Dbm::DBMOpenLogin(\%login); # Retreive login dbm Webchat::Database::DocumentGetAUP($Database); # Display Acceptable use Policy print $cgi->start_form(); # Beginning of form # Embed information gathered foreach $single (sort keys %{$param}) { # Make sure submit is not embeded if ($param->{$single} ne $login{'TxtSubmitButtonSub'}) { # Print parameters into hidden parameters print "\t", $cgi->hidden($single, $param->{$single}), "\n"; } } # Print official acceptence print "\t", $cgi->hidden('ACCEPT', 'Agreed'), "\n"; # Print access button print "\t", $cgi->submit($login{'TxtSubmitButtonAccept'}), "\n"; print $cgi->end_form(); # End of form Webchat::Dbm::DBMClose(\%login); # Free DBM from hash } ##################### # Request Handler # # Takes in the parameters, sending a part of the information to the database, then # sending a confirmation E-Mail to the poster. sub RequestHandler # Database, CGI, Parameter hash { ##################### # Data members my $Database = shift; # Database handle my $param = shift; # Parameter hash my $rand = new String::Random; # Random string my $invitation; # Invitation my $confcode = $rand->randpattern("ssssssssss"); # Confirmation code my $authstring; # Authenthication string my $authlogin; # Authenthication name my %system; # System hash to DBM my %login; # Login hash to DBM ##################### # Program area # Associate hashes with DBM Webchat::Dbm::DBMOpenLogin(\%login); Webchat::Dbm::DBMOpenSystem(\%system); Webchat::Database::DocumentGetRegistration($Database); # Information on registration $invitation = Webchat::Database::DocumentGetInvitation($Database); # Create authenthication string $authlogin = Webchat::Login::Remangle($param->{'USERNAME'}); $authstring = "$system{'LocScriptReg'}?LOGIN=$authlogin&CONFCODE=$confcode"; # Message information if (defined($invitation)) { # Go though all keywords and replace with real value $invitation =~ s/FULLNAME/$param->{'FULLNAME'}/g; $invitation =~ s/SERVERNAME/$system{'SetInfoServer'}/g; $invitation =~ s/LOGINNAME/$param->{'USERNAME'}/g; $invitation =~ s/AUTHSTRING/$authstring/g; $invitation =~ s/RETURNEMAIL/$system{'SetInfoContactAddress'}/g; } # Define and open sendmail open(SENDMAIL, "|$system{'LocSendmail'} -oi -t") or die("Cannot fork sendmail: $!"); # Send out invitation print SENDMAIL "From: $system{'SetInfoContactName'} <$system{'SetInfoContactAddress'}>\n"; print SENDMAIL "To: $param->{'FULLNAME'} <$param->{'EMAIL'}>\n"; print SENDMAIL "Subject: Welcome to $system{'SetInfoServer'}\n\n"; print SENDMAIL "$invitation\n"; close(SENDMAIL); # Remove underscores $param->{'USERNAME'} = Webchat::Login::Unmangle($param->{'USERNAME'}); # Insert Puppeteer $Database->do("INSERT INTO Puppeteer VALUES (?,?,?,?,?,?,?,?, 'no', 'no')", {}, $param->{'USERNAME'}, crypt($param->{'PASSONCE'}, $confcode), $param->{'FULLNAME'}, $param->{'EMAIL'}, time, OptionFindFormatting($login{'OptFormat'},$param->{'FORMATPREFS'}), OptionFindChatprefs($login{'OptChatPref'},$param->{'CHATPREFS'}), OptionFindJavascript($login{'OptJavascript'},$param->{'JAVASCRIPT'})); $Database->do("INSERT INTO PuppeteerRegistration VALUES (?,?,?)", {}, $param->{'USERNAME'}, $confcode, time); Webchat::Dbm::DBMClose(\%system); # Disconnect hash from dbm Webchat::Dbm::DBMClose(\%login); # Disconnect hash from login } ##################### # OptionSplit # # Splits options list into seperate elements of array sub OptionSplit { ##################### # Data members my $array = shift; # Reference to array my $data = shift; # Retreived line ##################### # Program area @{ $array } = split(/:/, $data); # Split line } ##################### # OptionFind # # Splits options list into seperate elements of array and determines which # option was specifically selected for the database sub OptionFind { ##################### # Data members my $string = shift; # String with all options my $val = shift; # Value to search for my $choice = shift; # Flow of events my $counter = 0; # Basic counter my @values; # Array of values ##################### # Program area OptionSplit(\@values, $string); # Split options\receive values # Loop though array while ($string = shift @values) { # Verify for match if ($string eq $val) { last; } # If found exit loop $counter++; # Increment if no match found } # Javascript Options/Yes no Options if ($choice == 0) { # Which option applies if ($counter == 0) { return 'yes'; } elsif ($counter == 1) { return 'no'; } elsif ($counter == 2) { return 'yes'; } } # Chat preferences elsif ($choice == 1) { # Which option applies if ($counter == 0) { return 'basic'; } elsif ($counter == 1) { return 'framed'; } elsif ($counter == 2) { return 'stream'; } elsif ($counter == 3) { return 'basic'; } } # Format used in chat elsif ($choice == 2) { # Which option applies if ($counter == 0) { return 'complete'; } elsif ($counter == 1) { return 'imageless'; } elsif ($counter == 2) { return 'spartan'; } elsif ($counter == 3) { return 'complete'; } } } # Alias for Javascript sub OptionFindJavascript { return OptionFind(shift, shift, 0); } # Alias for Chat preferences sub OptionFindChatprefs { return OptionFind(shift, shift, 1); } # Alias for Formatting sub OptionFindFormatting { return OptionFind(shift, shift, 2); } ethereal-1.0.0/webchat/ 40755 0 0 0 7053646576 12722 5ustar rootrootethereal-1.0.0/webchat/Param.pm100644 0 0 11614 7053646576 14440 0ustar rootroot################################################################################# # Created : Martin Foster # Modified : 01/20/2000 ################################################################################# # # Param - Modules part of Webchat designed to handle parameters diffrently # Copyright (C) 2000 Martin Foster # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # # Author of this script can be contacted at the following: # E-Mail : mfoster@redwhite.com # Address : Suite 209 - 355 5th Ave NE # Calgary, Alberta # T2R 0K9 # ################################################################################# package Webchat::Param; use strict; # Strict variable enforcement use Webchat::Login; # Login procedures ################################################################################# # Data Members ################################################################################# ################################################################################# # Sub-Routines ################################################################################# ##################### # GetParam # # Due to the annoyance of having to retrieve parameters from the $cgi->param # command, I have opted to move them directly into a hash. Passable to functions # with little or no trouble and generally avoiding having the same value # re-applied to the parameter, causing problems for changes and easier calling # via a hash. sub GetParam { ##################### # Data members my $cgi = shift; # Handle to CGI my $hash = shift; # Reference to hash my @names; # Array of named parameters reveived my $param; # Specific parameter ##################### # Program area @names = $cgi->param(); # Get list of all parameters received # Cycle though parameter list while ($param = shift(@names)) { $hash->{$param} = $cgi->param($param); # Create hash with parameters $cgi->delete($param); # Delete parameter list as one goes } } ##################### # Embed Information # # Will embed username and password for next pass sub Embed # Database handle, CGI, Parameters { ##################### # Data members my $Database = shift; # Database handle my $Statement; # SQL Statement my $cgi = shift; # CGI Handle my $param = shift; # Parameter reference my $choice = shift; # Choice of the matter my $crypt; # Crypted password ##################### # Data members # Unmange for use $param->{'USER'} = Webchat::Login::Unmangle($param->{'USER'}); # Prepare and execute $Statement = $Database->prepare("SELECT PuppeteerPassword FROM Puppeteer WHERE PuppeteerLogin=?"); $Statement->execute($param->{'USER'}); # Retreive and finish $crypt = $Statement->fetchrow(); $Statement->finish(); # Remangle in order to use $param->{'USER'} = Webchat::Login::Remangle($param->{'USER'}); $param->{'ROOM'} = Webchat::Login::Remangle($param->{'ROOM'}); $param->{'CHAR'} = Webchat::Login::Remangle($param->{'CHAR'}); $param->{'NUM'} = Webchat::Login::Remangle($param->{'NUM'}); # If embed if ($choice == 0) { # Embed crypt and user print "\t", $cgi->hidden('USER', $param->{'USER'}), "\n"; print "\t", $cgi->hidden('CRYPT', $crypt), "\n"; # Verify then encrypt if ( defined($param->{'ROOM'}) ) { print "\t", $cgi->hidden('ROOM', $param->{'ROOM'}), "\n"; } if ( defined($param->{'CHAR'}) ) { print "\t", $cgi->hidden('CHAR', $param->{'CHAR'}), "\n"; } if ( defined($param->{'NUM'}) ) { print "\t", $cgi->hidden('NUM', $param->{'NUM'}), "\n"; } } # Inline embeding elsif ($choice == 1) { # Assign default values for user and crypt my $string = "?USER=$param->{'USER'}&CRYPT=$crypt"; # Verify then encrypt if ( defined($param->{'ROOM'}) ) { $string = "$string&ROOM=$param->{'ROOM'}"; } if ( defined($param->{'CHAR'}) ) { $string = "$string&CHAR=$param->{'CHAR'}"; } if ( defined($param->{'NUM'}) ) { $string = "$string&NUM=$param->{'NUM'}"; } # Return inline string return $string; } } # Alias for Normal sub EmbedNormal { Embed(shift, shift, shift, 0); } # Alias for Inline sub EmbedInline { return Embed(shift, shift, shift, 1); } 1; # Return true ethereal-1.0.0/webchat/Table.pm100644 0 0 7367 7053646576 14421 0ustar rootroot################################################################################# # Created : Martin Foster # Modified : 01/19/2000 ################################################################################# # # Table - Modules part of Webchat designed to simplify table creation # Copyright (C) 2000 Martin Foster # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # # Author of this script can be contacted at the following: # E-Mail : mfoster@redwhite.com # Address : Suite 209 - 355 5th Ave NE # Calgary, Alberta # T2R 0K9 # ################################################################################# package Webchat::Table; # Package name ################################################################################# # Data Members ################################################################################# ################################################################################# # Sub-Routines ################################################################################# ##################### # Make Table # # Table contruction sub-routine, designed to hopefully cut down on code for certain # apects of scripts needed it. sub Make { ##################### # Data members my $cgi = shift; # CGI handle my $choice = shift; # Decision to make ##################### # Program area # Top of table if ($choice == 0) { print "
\n"; } # Print top of table # blank row of table elsif ($choice == 1) { print "\t\n\t\t\n\t\t\n\t\t\n\t\n"; } # Filled row of table (Invalid) elsif ($choice == 2) { print "\t\n"; # Beginning of row print "\t\t\n"; print "\t\t\n"; print "\t\t\n"; print "\t\n"; # End of row } # Filled row of table (Done) elsif ($choice == 3) { print "\t\n"; # Beginning of row print "\t\t\n"; print "\t\t\n"; print "\t\t\n"; print "\t\n"; # End of row } # Filled row of table (Changed) elsif ($choice == 4) { print "\t\n"; # Beginning of row print "\t\t\n"; print "\t\t\n"; print "\t\t\n"; print "\t\n"; # End of row } # Single row elsif ($choice == 5) { print "\t\n"; # Beginning of row print "\t\t\n"; print "\t\n"; # End of row } # bottom of table elsif ($choice == 6) { print "
$_[0]*$_[1]
$_[0]$_[1]
$_[0]*$_[1]
$_[0]
\n"; } } # Alias for top sub MakeTop { Make(shift, 0); } # Alias for bottom sub MakeBottom { Make(shift, 6); } # Alias for Blank rows sub MakeBlank { Make(shift, 1); } # Alias for Invalid entries sub MakeInvalid { Make(shift, 2, @_); } # Alias for Valid entries sub MakeValid { Make(shift, 3, @_); } # Alias for Changed entries sub MakeChanged { Make(shift, 4, @_); } # Alias for single sub MakeSingle { Make(shift, 5, @_); } 1; # Return true ethereal-1.0.0/webchat/Comm.pm100644 0 0 33621 7053646576 14275 0ustar rootroot################################################################################# # Created : Martin Foster # Modified : 01/30/2000 ################################################################################# # # Comm - Module part of Webchat designed to prompt and handle posts. # Copyright (C) 2000 Martin Foster # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # # Author of this script can be contacted at the following: # E-Mail : mfoster@redwhite.com # Address : Suite 209 - 355 5th Ave NE # Calgary, Alberta # T2R 0K9 # ################################################################################# package Webchat::Comm; # Pacakace name use strict; # Strict variable enforcement use Webchat::Database; # Database handler use Webchat::Dbm; # DBM Addition use Webchat::Login; # Login functionality use Webchat::Param; # Parameter control ################################################################################# # Sub-Routines ################################################################################# ##################### # Comm # # Subroutine primarily charged with displaying input area. This will also call # CommHandler which will handle the requests to determin the need for a new # database entry sub Comm # Database, CGI, Parameter list { ##################### # Data members my $Database = shift; # Database handle my $cgi = shift; # CGI handle my $param = shift; # Parameter list my $choice = shift; # Choice of the matter my $java; # Java options my $inline; # Inline argument list my $url = $cgi->url(); # Url of script my $puppet; # Puppet name my $color; # Colour default my $size; # Size default my @color; # Colours my @size; # Size fonts my @char; # Character my %chat; # Portal hash ##################### # Program area # Link DBM to hash Webchat::Dbm::DBMOpenChat(\%chat); # Populate arrays OptionSplit(\@color, $chat{'OptTextColour'}); OptionSplit(\@size, $chat{'OptTextSize'}); Webchat::Database::GetListPuppetYours($Database, \@char, $param->{'USER'}); # Define inline and puppet $inline = Webchat::Param::EmbedInline($Database, $cgi, $param); $puppet = Webchat::Login::Unmangle($param->{'CHAR'}); # Retreive size and color ($size, $color) = Webchat::Database::DataGetFont($Database, $puppet, $color[0]); # Independent HTML if ($choice != 0) { # Print file and HTML header print $cgi->header(-target=>'comm'); print $cgi->start_html('Chat subsection'); } # With or without javascript as prescribed # Determine need for javascript ($java) = Webchat::Database::DataGetJavascript($Database, Webchat::Login::Unmangle($param->{'USER'})); # Print if javascript is desired if ($java eq 'yes') { Webchat::Database::DocumentGetJavascript($Database); } # HTML # Form if ($choice == 1) # Framed { print $cgi->start_form(-encoding=>'application/x-www-form-urlencoded', -method=>'POST', -action=>"$url", -name=>'Comm'); } else # Dependant/streaming version { print $cgi->start_form(); } # Top and beautifying code print "
\n\n"; print "\t\n\t\t\n\t\n"; # Posting field and side spacers print "\t\t\t\n"; print "\t\t\n"; print "\t\t\n\t\n"; # Puppet selection print "\t\n\t\t\n"; # Puppet submit print "\t\t\n\t\n"; # Text modifications print "\t\n\t\t\n\t\n"; print "\t\n\t\t\n\t\n"; # Links if ($java eq 'yes') { # Javascript enabled print "\t\n\t\t\n\t\n"; } else { print "\t\n\t\t\n\t\n"; } # Table Bottom print "
$chat{'SetTop'}
..
$chat{'TagPuppet'}", $cgi->popup_menu('CHAR', \@char, $puppet), "", $cgi->submit($chat{'TxtSubmitButton'}),"
$chat{'TagTextColour'}", $cgi->popup_menu('COLOR', \@color, $color), "
$chat{'TagTextSize'}", $cgi->popup_menu('SIZE', \@size, $size), "
", "$chat{'TagLnkPuppet'}", "$chat{'TagLnkIgnore'}", "$chat{'TagLnkWho'}", "$chat{'TagLnkPrivate'}", "
", "$chat{'TagLnkPuppet'}", "$chat{'TagLnkIgnore'}", "$chat{'TagLnkWho'}", "$chat{'TagLnkPrivate'}", "
\n
\n"; # Embed Webchat::Param::EmbedNormal($Database, $cgi, $param); # Embed Main for Comm if ($choice == 1) # For framed chat { print "\t", $cgi->hidden('MAIN', 'Of course...'), "\n"; } elsif ($choice == 2) # For streaming { print "\t", $cgi->hidden('COMM', 'Of course...'), "\n"; } # End of form print $cgi->end_form(), "\n"; # Print end of html if needed if (($choice == 0) || ($choice eq 'no')) { print $cgi->end_html(); } # Unlink DBM to hash Webchat::Dbm::DBMClose(\%chat); } # Alias for dependency sub CommDependant { Comm(shift, shift, shift, 0); } # Alias for independence sub CommIndependant { Comm(shift, shift, shift, 1); } # Alias for independence sub CommStream { Comm(shift, shift, shift, 2); } ##################### # DataWrite # # Encharged with properly handling information and actually making posts # once formatted inserting them into the database. sub DataWrite # Database, param { ##################### # Data members my $Database = shift; # Database get my $param = shift; # Parameters my $hex; # Hex colour my %chat; # Chat hash ##################### # Data members # Unmangle information $param->{'CHAR'} = Webchat::Login::Unmangle($param->{'CHAR'}); $param->{'ROOM'} = Webchat::Login::Unmangle($param->{'ROOM'}); # Assign to target if undefined unless (defined($param->{'TARGET'})) { $param->{'TARGET'} = 'all'; } # Only do following if posts exist if ((defined($param->{'POST'})) && (($param->{'POST'} =~ tr/a-zA-Z0-9*:()//) > 1)) { # Link DBM to hash Webchat::Dbm::DBMOpenChat(\%chat); # Determin font information $param->{'COLOR'} = Webchat::Login::Unmangle($param->{'COLOR'}); $hex = OptionFindColor($chat{'OptTextColour'}, $chat{'OptTextColourHex'}, $param->{'COLOR'}); # Update database entry $Database->do("UPDATE Puppet SET PuppetTextColour=?, PuppetTextSize=? WHERE PuppetName=?", {}, $param->{'COLOR'}, $param->{'SIZE'}, $param->{'CHAR'}); # Handle posts PostHandler($Database, $param, \%chat); # Unlink DBM to hash Webchat::Dbm::DBMClose(\%chat); } # No post simply post for timestamp purposes else { $Database->do("INSERT INTO Post VALUES(NULL, ?, ?, 'system', ?, NULL, NULL, NULL)", {}, $param->{'ROOM'}, $param->{'CHAR'}, time); } } ##################### # OptionSplit # # Splits options list into seperate elements of array sub OptionSplit { ##################### # Data members my $array = shift; # Reference to array my $data = shift; # Retreived line ##################### # Program area @{ $array } = split(/:/, $data); # Split line } ##################### # OptionFindColor # # Splits options lists and determins hex value of post sub OptionFindColor # Colors, Hex, Value { ##################### # Data members my $colors = shift; # String of colours my $hex = shift; # String of hex colours my $value = shift; # Value to seach for my @colors; # Array of colors my @hex; # Array of hex values ##################### # Program area # Retreive colours and hex OptionSplit(\@colors, $colors); OptionSplit(\@hex, $hex); # Find lenght of colors $_ = @colors; # Determine proper index for (my $count; $count < $_; $count++) { # And return once found if ($colors[$count] eq $value) { return $hex[$count]; } } } ##################### # Post Handler # # Depending on rules will handle the formatting of the three styles of posts # filter language and HTML if needed or specified. sub PostHandler { ##################### # Data members my $Database = shift; # Database handle my $param = shift; # Reference to parameters my $chat = shift; # Reference to chat my $full; # Full formating my $imageless; # No images my $spartan; # Spartan formatting my $title; # Title my $tag; # Tagline my $start; # Start of table my $end; # End of table my @realm; # Realm information my @puppet; # Puppet information my @lang; # Language array my @realmpic; # Ream picture restriction my @time = gmtime(time); # Time my %chat; # Chat DBM ##################### # Program area # Retreive puppet and realminformation @puppet = Webchat::Database::DataGetPuppetInfo($Database, $param->{'CHAR'}); @realm = Webchat::Database::DataGetRealmInfo($Database, $param->{'ROOM'}); # Remove any underscores $param->{'POST'} = Webchat::Login::Unmangle($param->{'POST'}); # Language filtering if ($realm[0] eq 'restricted') { # Retreive words # Prepare and execute my $Statement = $Database->prepare("SELECT WordSpelling FROM WordRestriction WHERE RealmName=?"); $Statement->execute($param->{'ROOM'}); # Retreive and place in array while ($_ = $Statement->fetchrow()) { push(@lang, $_); } $Statement->finish; # Run though array of words and filter post $_ = @lang; # Get lenght for (my $count=0; $count < $_; $count++) { $param->{'POST'} =~ s/$lang[$count]/****/gsi; } } # Format title if (defined($puppet[6])) { # Verify if NAME attribute exists if ($puppet[6] =~ /NAME/) { $puppet[6] =~ s/NAME/$param->{'CHAR'}/g; $title = $puppet[6]; } # Otherwise prepend name else { $title = "$param->{'CHAR'} $title"; } } # Assign chacter name to title else { $title = $param->{'CHAR'}; } # Create formatted line $title = "$title"; # Format tagline and time $time[4] += 1; # Correct month $time[5] += 1900; # Full year # Create tagline unless (($param->{'TARGET'} ne 'all') && ($param->{'TARGET'} ne 'system')) { $tag = "($puppet[2]) ($time[2]:$time[1]GMT $time[4]/$time[3]/$time[5])"; } else { $tag = "($puppet[2]) (From: $param->{'CHAR'}) ($time[2]:$time[1]GMT $time[4]/$time[3]/$time[5])"; } # Filter HTML if option is selected if ($realm[1] eq 'restricted') { $param->{'POST'} =~ s/<[^>]*>//gs; } # Determine colour my $hex = OptionFindColor($chat->{'OptTextColour'}, $chat->{'OptTextColourHex'}, $param->{'COLOR'}); # Add colors $param->{'POST'} = "{'SIZE'}\" COLOR=\"$hex\">$param->{'POST'}"; # If images use following if (defined($puppet[3])) { # Retreive image size information @realmpic = Webchat::Database::DataGetRealmImageInfo($Database, $param->{'ROOM'}); # Format image format accordingly if ((($realmpic[0] != 0) && ($realmpic[1] != 0)) && (($puppet[4] > $realmpic[0]) || ($puppet[5] > $realmpic[1]))) { $full = "$chat->{'TagLnkImage'}
$title $tag
$param->{'POST'}"; } else { $full = "$title $tag
$param->{'POST'}"; } # Format non imaged format $imageless = "$title $tag
$param->{'POST'}"; } else { # Non imaged format which is assigned to full if no image is found $imageless = "$title $tag
$param->{'POST'}"; $full = $imageless; } # Create spartan format $param->{'POST'} =~ s/<[^>]*>//gs; $spartan = "$title $tag
$param->{'POST'}

"; # Embed all formats in tables unless (($param->{'TARGET'} ne 'all') && ($param->{'TARGET'} ne 'system')) { # For normal posts $start = "\n\n\t\t\n\t\n
"; $end = "
\n"; } else { # Embed for private posts $start = "\n\n\t\t\n\t\n
"; $end = "
\n"; } $full = "$start$full$end"; $imageless = "$start$imageless$end"; $spartan = "$start$spartan$end"; # Insert into database $Database->do("INSERT INTO Post VALUES(NULL, ?, ?, ?, ?, ?, ?, ?)", {}, $param->{'ROOM'}, $param->{'CHAR'}, $param->{'TARGET'}, time, $full, $imageless, $spartan); # Insert message to be returned to poster if (($param->{'TARGET'} ne 'all') && ($param->{'TARGET'} ne 'system')) { $Database->do("INSERT INTO Post VALUES(NULL, ?, ?, ?, ?, ?, ?, ?)", {}, $param->{'ROOM'}, $param->{'CHAR'}, $param->{'SOURCE'}, time, $full, $imageless, $spartan); } } 1; # Return true ethereal-1.0.0/webchat/Dbm.pm100644 0 0 35333 7053650312 14065 0ustar rootroot################################################################################# # Created : Martin Foster # Modified : 02/18/2000 ################################################################################# # # DBM - Modules part of Webchat designed to hide DBM # Copyright (C) 2000 Martin Foster # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # # Author of this script can be contacted at the following: # E-Mail : mfoster@redwhite.com # Address : Suite 209 - 355 5th Ave NE # Calgary, Alberta # T2R 0K9 # ################################################################################# package Webchat::Dbm; ################################################################################# # Data Members ################################################################################# ##################### # File locations $prefix = '/usr/share/webchat'; # Prefix to dbm directory $mysql = "$prefix/mysql"; # MySQL connect dbm $realm = "$prefix/realm"; # Realm tags dbm $portal = "$prefix/portal"; # Portal tags dbm $login = "$prefix/login"; # Login tags dbm $config = "$prefix/config"; # Configuration tags dbm $chat = "$prefix/chat"; # Chat tags dbm $system = "$prefix/system"; # System information dbm $bypass = 0; # Bypass filecheck (default no) ################################################################################# # Sub-Routines ################################################################################# ##################### # DBMClose # # Sub-Routine designed to hide the ugliness of dbmclose. Unlike it's cousin # dbmopen it will not kill the program, merely warn one. sub DBMClose { ##################### # Data members $hash = shift; # Reference to hash ##################### # Program area dbmclose(%{$hash}) # Unlink DBM from Hash or warn("Open DBM error : $!"); # Or die } ##################### # DBMOpen # # Sub-Routine designed to hide the ugliness of dbmopen and dbmclose. While may # not be needed in general use. This allows to open specific hashes without much # headache, as you call a subroutine instead of a function with all arguments. sub DBMOpen # Hash referece, filename { ##################### # Data members $hash = shift; # Reference to hash $file = shift; # Non referece to file $choice = shift; # Choice of operations ##################### # Program area # If bypass is disabled unless ($bypass) { # Do file check for read and existence if ((-f $file) && (-R $file)) { dbmopen(%{$hash}, $file, 0644) # Link DBM to Hash or die("Open DBM error : $!"); # Or die } # If check fails reset else { DBMReset($choice); # Call and reset to defaults warn("DBM $file was reset"); } } # If bypass is enabled else { dbmopen(%{$hash}, $file, 0644) # Link DBM to Hash or die("Open DBM error : $!"); # Or die } } # Alias for MySQL dbm sub DBMOpenMySQL { DBMOpen(shift, $mysql, 0); } # Alias for Realm dbm sub DBMOpenRealm { DBMOpen(shift, $realm, 1); } # Alias for Portal dbm sub DBMOpenPortal { DBMOpen(shift, $portal, 2); } # Alias for Login dbm sub DBMOpenLogin { DBMOpen(shift, $login, 3); } # Alias for Configuration dbm sub DBMOpenConfiguration { DBMOpen(shift, $config, 4); } # Alias for Configuration dbm sub DBMOpenConfig { DBMOpen(shift, $config, 4); } # Alias for chat dbm sub DBMOpenChat { DBMOpen(shift, $chat, 5); } # Alias for System dbm sub DBMOpenSystem { DBMOpen(shift, $system, 6); } ##################### # DBMReset # # Resets all DBMs to their default values. While this sub-routine is rarely # used, it nicely fits with this Module. sub DBMReset # Choice { ##################### # Data members my %mysql; # MySQL connect my %realm; # Realm tags my %portal; # Portal tags my %login; # Login tags my %config; # Configuration my %chat; # Chat my %system; # System settings my $action = shift; # Action to take ##################### # Program area $bypass = 1; # Enable file check bypass # MySQL # # Needed information to connect to the MySQL database without which # connection would not be possible. if ($choice == 0) { DBMOpenMySQL(\%mysql); %mysql = ( 'SetServer' => 'localhost', # Server name 'SetDatabase' => 'webchat', # Database name 'SetUser' => 'webchat', # Username 'SetPass' => '', # Password used 'SetPort' => '3306' # Default port ); } # Realm # # Information to change format and language of Realms elsif ($choice == 1) { DBMOpenRealm(\%realm); %realm = ( # Tags 'TagTitle' => 'Realm Title', # Realm title 'TagTitlePortal' => 'Portal', # Portal link 'TagTitlePrivate' => 'Private Message', # Private message link 'TagTitleWho' => 'Who is on', # Who is on link 'TagTitleConfIgnore' => 'Ignore List', # Ingore list link 'TagTitleConfPuppet' => 'Settings', # Puppet settings link 'TagTitleRealm' => 'Welcome to REALM', # Realm title 'TagPost' => 'Post', # Post tag # Settings 'SetTimeout' => '300', # Time seconds for existence 'SetPriColour' => '#FFFFFF', # Primary colour 'SetSecColour' => '#C0C0C0', # Secondary colour 'SetTextColour' => '#330033', # Text Colour # Links to next script 'LnkPortal' => 'portal.plx', # Portal link 'LnkPrivate' => 'private.plx', # Private message link 'LnkRealm' => 'realm.plx', # Link to realm 'LnkWho' => 'who.plx', # Who is on 'LnkConfIgnore' => './config/config-ignore.plx', 'LnkConfPuppet' => './config/config-puppet.plx', 'LnkBlank' => 'http://andrastea.dynodns.net/blank.html', # Text entries 'TxtSubmit' => 'Enter' # Submit button text ); } # Portal # # Information to change format and language of portal to realms elsif ($choice == 2) { DBMOpenPortal(\%portal); %portal = ( 'TagTitle' => 'Portal Title', # Portal Title 'TagSelectPuppet' => 'Select puppet', # Puppet selection prompt 'TagSelectRealm' => 'Select realm', # Realm selection prompt 'TagSelectPrivate' => 'Private create/join', # Option to create or join PR 'TagLnkPuppet' => 'Puppet configuration', # Puppet configuration 'TagLnkPuppeteer' => 'Puppeteer configuration', # Puppeteer configuration 'TagLnkSupervisor' => 'Supervisory functions', # Supervisory functions 'TagLnkIgnore' => 'Ignore lists', # Ignore tag 'TagSecRealm' => 'Realm entrance', # Realm entrance section 'TagSecPuppeteer' => 'Puppeteers section', # Puppeteers section # Text entries 'TxtSubmitRealms' => 'Enter', # Submit button text 'TxtResetRealms' => 'Reset', # Reset button text # Links to next script 'LnkRealm' => 'realm.plx', # Realm link 'LnkPuppet' => './config/config-puppet.plx', 'LnkPuppeteer' => './config/config-puppeteer.plx', 'LnkIgnore' => './config/config-ignore.plx', 'LnkRealm' => './config/config-realm.plx' ); } # Login # # Information to change format and language of login screen elsif ($choice == 3) { DBMOpenLogin(\%login); %login = ( 'TagTitleGeneral' => 'Login Title', # Login title tag 'TagTitleAdmin' => 'Admin login', # Admin login tag 'TagTitleRegister' => 'Registration', # Registration tag 'TagEMail' => 'Email address', # EMail address tag 'TagFullName' => 'Full Name', # Full name tag 'TagUsername' => 'Username:', # Username tag 'TagPassword' => 'Password:', # Password tag 'TagPasswordRepeat' => 'Repeat Password:', # Repeat password 'TagPasswordOld' => 'Old Password:', # New password tag 'TagOptJavacript' => 'Javascript options', # Javascript options tag 'TagOptChatPref' => 'Chat style', # Chat style tag 'TagOptFormat' => 'Chat format', # Chat format # Grouped options (maintain order) 'OptJavascript' => 'Use Javacript:No Javascript:Default', 'OptChatPref' => 'Basic chat:Framed chat:Streaming chat:Default', 'OptFormat' => 'Full formating:No images:Limited formating:Default', # Text options 'TxtResetButton' => 'Clear', # Clear button text 'TxtSubmitButton' => 'Login', # Submit button text 'TxtSubmitButtonSub' => 'Submit', # Submit button text 'TxtSubmitButtonAccept' => 'Accept', # Submit button text # Links to next script 'LnkPortal' => 'portal.plx', # Portal link 'LnkRealm' => 'realm.plx' # Realm link ); } # Configuration # # Generalized for configuration screens for the user, pupper and realm # This is to releive need for multiple hashes, when script are low priority elsif ($choice == 4) { DBMOpenConfiguration(\%config); %config = ( 'TagTitle' => 'Configuration', # Configuration title # Realm tags 'TagRealmLanguage' => 'Language options', # Language options tag 'TagRealmTags' => 'HTML Tag options', # HTML tag options tag 'TagRealmAccess' => 'Access control', # Access control tag 'TagRealmGuests' => 'Guest control', # Guess access control tag 'TagRealmInfo' => 'Realm Information', # Realm information 'TagRealmHeader' => 'Header', # Realm header 'TagRelamFooter' => 'Footer', # Realm footer 'TagRealmRealmSelect' => 'Select Realm', # Select Realm display 'TagRealmRealmFunction' => 'Function', # Realm function 'TagRealmBannings', => 'Bannings', # Banning control 'TagRealmWords', => 'Word Restrictions', # Word Restriction # Puppeteer tags 'TagConfPassword' => 'Change password', # Password change prompt 'TagConfEMail' => 'Change email address', # EMail changeover 'TagConfIgnore' => 'Ignore list', # Ignore list 'TagConfSuccess' => 'Change successful', # Change successful # Error messages 'ErrPassword' => 'Invalid Password', # Invalid password 'ErrMismatch' => 'Passwords do not match', # Mismatched passwords 'ErrEMail' => 'Email address is invalid', # Not proper E-Mail # Puppet related 'TagPupImageLink' => 'Image Link', # Image Link 'TagPupTagline' => 'Tagline', # Tagline tag 'TagPupBio' => 'Puppet bio', # Bio title change tag 'TagPupAddition' => 'Addition', # Addition button 'TagPupDelSelect' => 'Select/Delete', # Delete select button 'TagPupName' => 'Puppet Name', # Puppet name 'TagPupTitle' => 'Tilte', # Title 'TagPupImgHeight' => 'Image Height', # Image Height 'TagPupImgWidth' => 'Image Width', # Image Width # General 'TagGenAdd' => 'Add', # Add tag 'TagGenRemove' => 'Remove', # Remove tag # Grouped options (maintain order) 'OptLanugage' => 'relaxed:restricted', 'OptTags' => 'relaxed:restricted', 'OptAccess' => 'relaxed:restricted:list', 'OptGuests' => 'Allow:Disallow:Posting', # Text options 'TxtResetButton' => 'Reset', # Clear button text 'TxtSubmitButton' => 'Submit', # Submit button text 'TxtSubmitView' => 'View', # View button 'TxtSubmitDelete' => 'Delete', # Delete button 'TxtSubmitAddition' => 'Add' # Addition button ); } # Chat # # Since these tags are used in multiple scipts they were seperated elsif ($choice == 5) { DBMOpenChat(\%chat); %chat = ( # Settings 'SetBGColor' => '#FFFFFF', # Background colour 'SetTop' => '<--->', # Top part # Tags 'TagTextColour' => 'Textcolour', # Text colour tag 'TagTextSize' => 'Textsize', # Text size tag 'TagPuppet' => 'Puppet', # Puppet prompt tag 'TagPuppetTo' => 'To', # Puppet to 'TagLnkPuppet' => '[Config]', # Cofiguration 'TagLnkIgnore' => '[Ignore]', # Ignore 'TagLnkPrivate' => '[Private]', # Private 'TagLnkWho' => '[Who]', # Who am I 'TagLnkImage' => '[Image]', # Image link 'TagSeperator' => '
', # Seperator # Options 'OptTextColour' => 'Black:Grey:Silver:Fuschia:Green:Lime:Olive:Teal:Blue:Navy:Purple:Maroon:Red', 'OptTextColourHex' => '#000000:#666666:#999999:#FF99FF:#009900:#33FF33:#999900:#408080:#3333FF:#000099:#663366:#993366:#FF6666', 'OptTextSize' => '-2:-1:+1:+2:+3', # Text options 'TxtSubmitButton' => 'Post/View', # Submit button text 'TxtResetButton' => 'Clear', # Reset button text 'LnkPuppet' => './config/config-puppet.plx', 'LnkPuppeteer' => './config/config-puppeteer.plx', 'LnkIgnore' => './config/config-ignore.plx', 'LnkWho' => './post/who.plx', 'LnkPrivate' => './post/private.plx' ); } # System # # Information that affects core operations, such as timeouts, addresses # defaults for new users, realms et cetera. elsif ($choice == 6) { DBMOpenSystem(\%system); %system = ( # Settings 'SetTimeDay' => '86400', # Seconds in a day 'SetTimeoutRegister' => '5', # Timeout (days) for registration 'SetTimeoutBanned' => '5', # Tiemout (days) for ban on puppeteer 'SetTimeoutRealm' => '1', # Timeout (days) for ban on realm 'SetTimeoutPuppeteer' => '90', # Timeout (days) for puppeteer idle 'SetAllowPrivateRealm' => 'yes', # Restrict private realm creations 'SetAllowPrivateMsg' => 'yes', # Restrict sending of private messages 'SetInfoServer' => 'Ethereal Realms', # Server name 'SetInfoContactName' => 'Webmaster', # Contact name 'SetInfoContactAddress' => 'webmaster@www.net', # Contact email address # Location 'LocSendmail' => '/usr/sbin/sendmail', # Sendmail location 'LocScriptReg' => 'http://www/cgi-bin/registration.plx', 'LocTemp' => '/tmp' # Temporary storage folder ); } # All elsif ($choice == 99) { # Call each individual function DBMResetMySQL(); DBMResetRealm(); DBMResetPortal(); DBMResetLogin(); DBMResetConfiguration(); DBMResetChat(); DBMResetSystem(); } $bypass = 0; # Reset bypass to normal (false) } # Alias for sub DBMResetMySQL { DBMReset(0); } # Alias for Realm sub DBMResetRealm { DBMReset(1); } # Alias for Portal sub DBMResetPortal { DBMReset(2); } # Alias for Login sub DBMResetLogin { DBMReset(3); } # Alias for Configuration sub DBMResetConfiguration { DBMReset(4); } # Alias for Chat sub DBMResetChat { DBMReset(5); } # Alias for System sub DBMResetSystem { DBMReset(6); } # Alias for All DBMs sub DBMResetAll { DBMReset(99); } 1; # Return true ethereal-1.0.0/webchat/Database.pm100644 0 0 24460 7053646576 15107 0ustar rootroot################################################################################# # Created : Martin Foster # Modified : 02/18/2000 ################################################################################# # # Database - Modules part of Webchat designed to aid Database programming # Copyright (C) 2000 Martin Foster # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # # Author of this script can be contacted at the following: # E-Mail : mfoster@redwhite.com # Address : Suite 209 - 355 5th Ave NE # Calgary, Alberta # T2R 0K9 # ################################################################################# package Webchat::Database; # Package name use DBI; # Database indepedent use Webchat::Dbm; # Dbm webchat module ################################################################################# # Data Members ################################################################################# ################################################################################# # Sub-Routines ################################################################################# ##################### # Database Connect # # Sub-routine to allow connection to the database while revealing as little as # possible to the coder. Also centralized sub DatabaseConnect # Database reference handle { ##################### # Data members my $Database = shift; # Database handle my %Connect; # Connection hash ##################### # Program area Webchat::Dbm::DBMOpenMySQL(\%Connect); # Retreive connection information ${$Database} = DBI->connect("DBI:mysql:$Connect{'SetDatabase'}:$Connect{'SetServer'}:$Connect{'SetPort'}", $Connect{'SetUser'}, $Connect{'SetPass'}, {PrintError => 1}) || die ("MySQL Error \#$DBI::err : $DBI::errstr"); Webchat::Dbm::DBMClose(\%Connect); # Close DBM } ##################### # Document Get # # Data retreival sub-routine for WebchatText table in Webchat database sub DocumentGet # Database handle, field { ##################### # Data members my $Database = shift; # Database handle my $Statement; # SQL statement my $field = shift; # Search field my $data; # Data pulled from database ##################### # Program area # Initialize and execute $Statement = $Database->prepare("SELECT WebchatTextContent FROM WebchatText WHERE WebchatTextName=?"); $Statement->execute($field); # Retreive and finish $data = $Statement->fetchrow(); $Statement->finish; # Return gathered information return $data; } # Alias for Acceptable Use Policy sub DocumentGetAUP { print DocumentGet(shift, 'AcceptableUsePolicy'); } # Alias for Header sub DocumentGetHeader { print DocumentGet(shift, 'WebHeader'); } # Alias for Footer sub DocumentGetFooter { print DocumentGet(shift, 'WebFooter'); } # Alias for Invitation sub DocumentGetInvitation { return DocumentGet(shift, 'Invitation'); } # Alias for Sidebar sub DocumentGetSidebar { print DocumentGet(shift, 'WebSidebar'); } # Alias for Realm sub DocumentGetRealm { print DocumentGet(shift, 'InfoRealm'); } # Alias for Bio sub DocumentGetBio { print DocumentGet(shift, 'InfoBio'); } # Alias for Registration sub DocumentGetRegistration { print DocumentGet(shift, 'Registration'); } # Alias for Accepted registration sub DocumentGetAccepted { print DocumentGet(shift, 'Accepted'); } # Alias for Javascript sub DocumentGetJavascript { print DocumentGet(shift, 'WebJavascript'); } ##################### # GetList # # Sub-routine created to take a reference to an array and retrieve a list of # all records within a specific field of information. sub GetList # Database handle, reference to array, SQL { ##################### # Data members my $Database = shift; # Database handle my $array = shift; # Reference of array my $query = shift; # SQL query my $Statement; # SQL Statement ##################### # Program area # Prepare and execute $Statement = $Database->prepare($query); $Statement->execute(); # Retrieve and place in array while ($_ = $Statement->fetchrow()) { push(@{ $array }, $_); } # End statement $Statement->finish; } # Alias for documents sub GetListDocuments { GetList(shift, shift, 'SELECT WebchatTextName FROM WebchatText ORDER BY WebchatTextName'); } # Alias for public realms sub GetListPublicRealms { GetList(shift, shift, "SELECT RealmName FROM Realm WHERE RealmPublic='yes' ORDER BY RealmName"); } # Alias for private realms sub GetListPrivateRealms { GetList(shift, shift, "SELECT RealmName FROM Realm WHERE RealmPublic='no' ORDER BY RealmName"); } # Alias for puppet listing other then puppeteers sub GetListPuppetOther { GetList(shift, shift, "SELECT PuppetName FROM Puppet WHERE PuppeteerLogin <> '$_[0]' ORDER BY PuppetName"); } # Alias for puppet listing that are yours sub GetListPuppetYours { GetList(shift, shift, "SELECT PuppetName FROM Puppet WHERE PuppeteerLogin='$_[0]' ORDER BY PuppetName"); } # Alias for puppet listing that are yours sub GetListPuppetIgnored { GetList(shift, shift, "SELECT PuppetName FROM PuppetIgnore WHERE PuppeteerLogin='$_[0]' ORDER BY PuppetName"); } # Alias for EMail retreival sub GetListEMails { GetList(shift, shift, "SELECT DISTINCT(PuppeteerEMail) FROM Puppeteer ORDER BY PuppeteerEMail"); } # Alias for who is online sub GetListWho { GetList(shift, shift, "SELECT DISTINCT(PuppetName) FROM Post WHERE RealmName='$_[0]' AND PostTimestamp > '$_[1]' ORDER BY PuppetName"); } # Alias for expired puppeteers sub GetListExpire { GetList(shift, shift, "SELECT PuppeteerLogin FROM Puppeteer WHERE PuppeteerTimestamp < '$_[0]'"); } # Alias for bans sub GetListBanned { GetList(shift, shift, "SELECT PuppeteerLogin FROM PuppeteerRestriction WHERE RealmName='$_[0]'"); } # Alias for bans sub GetListWords { GetList(shift, shift, "SELECT WordSpelling FROM WordRestriction WHERE RealmName='$_[0]'"); } ##################### # GetData # # Generic sub-routine that will return a single row of data be it in multiple # amounts or just one field within the row there is a special section for # font handling if choice is at all defined. sub DataGet # Database, query, choice { ##################### # Data members my $Database = shift; # Database get my $Statement; # SQL Statement my $Query = shift; # Database query my $choice = shift; # Choice of the matter my @values; # Values returned from table ##################### # Program area # Prepare and execute $Statement = $Database->prepare($Query); $Statement->execute(); # Retreive and finish @values = $Statement->fetchrow(); $Statement->finish(); if (defined($choice)) { # Verify size unless (defined($values[0])) # Assign default if not defined { $values[0] = '+1'; } else # Otherwise properly format { # By appending '+' to the number if ($values[0] > 0) { $values[0] = "+$values[0]"; } } # Verify colour unless (defined($values[1])) { $values[1] = $choice; } # Assign default value if necessary } # Return retreived information return @values; } # Puppeteer # Alias for Puppeteer Info sub DataGetPuppeteerLogin { return DataGet(shift, "SELECT PuppeteerLogin FROM Puppet WHERE PuppetName='$_[0]'"); } # Alias for font settings sub DataGetFont { return DataGet(shift, "SELECT PuppetTextSize, PuppetTextColour FROM Puppet WHERE PuppetName='$_[0]'", $_[1]); } # Alias for Javascript option sub DataGetJavascript { return DataGet(shift, "SELECT PuppeteerJavascript FROM Puppeteer WHERE PuppeteerLogin='$_[0]'"); } # Alias for chat options sub DataGetChatOptions { return DataGet(shift, "SELECT PuppeteerJavascript, PuppeteerChatPref FROM Puppeteer WHERE PuppeteerLogin='$_[0]'"); } # Alias for Formatting option sub DataGetFormatting { return DataGet(shift, "SELECT PuppeteerFormatting FROM Puppeteer WHERE PuppeteerLogin='$_[0]'"); } # Alias for Supervisory option sub DataGetSupervisor { return DataGet(shift, "SELECT PuppeteerSuperPrivs FROM Puppeteer WHERE PuppeteerLogin='$_[0]'"); } # Alias for Supervisory option sub DataGetBannedStatus { return DataGet(shift, "SELECT PuppeteerLogin FROM PuppeteerRestriction WHERE PuppeteerLogin='$_[0]' AND RealmName='$_[1]'"); } # Alias for PuppeteerEmail retreival sub DataGetPuppeteerEmail { return DataGet(shift, "SELECT PuppeteerEmail FROM Puppeteer WHERE PuppeteerLogin='$_[0]'"); } # Puppets # Alias for Puppet Info sub DataGetPuppetInfo { return DataGet(shift, "SELECT * FROM Puppet WHERE PuppetName='$_[0]'"); } # Alias for Puppet Image Info sub DataGetPuppetImageInfo { return DataGet(shift, "SELECT PuppetPicHeight, PuppetPicWidth FROM Puppet WHERE PuppetName='$_[0]'"); } # Alias for Puppet Bio Info sub DataGetPuppetBio { return DataGet(shift, "SELECT PuppetBio FROM Puppet WHERE PuppetName='$_[0]'"); } # Realm # Alias for Realm Description sub DataGetRealmDescription { return DataGet(shift, "SELECT RealmInfo FROM Realm WHERE RealmName='$_[0]'"); } # Alias for Realm Info sub DataGetRealmInfo { return DataGet(shift, "SELECT RealmLanguage, RealmTags FROM Realm WHERE RealmName='$_[0]'"); } # Alias for Realm Image Info sub DataGetRealmImageInfo { return DataGet(shift, "SELECT RealmImageHeight, RealmImageWidth FROM Realm WHERE RealmName='$_[0]'"); } # Alias for Complete Realm Info sub DataGetRealmCompleteInfo { return DataGet(shift, "SELECT * FROM Realm WHERE RealmName='$_[0]'"); } # Alias for Realm existence sub DataGetRealmExistence { return DataGet(shift, "SELECT * SELECT RealmName FROM Realm WHERE RealmName='$_[0]'"); } # Alias for Realm HTML sub DataGetRealmHtml { return DataGet(shift, "SELECT RealmFooter, RealmHeader FROM Realm WHERE RealmName='$_[0]'"); } 1; # Return true ethereal-1.0.0/webchat/Who.pm100644 0 0 10753 7053646576 14140 0ustar rootroot################################################################################# # Created : Martin Foster # Modified : 01/22/2000 ################################################################################# # # Who - Modules part of Webchat designed to determine who is on # Copyright (C) 2000 Martin Foster # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # # Author of this script can be contacted at the following: # E-Mail : mfoster@redwhite.com # Address : Suite 209 - 355 5th Ave NE # Calgary, Alberta # T2R 0K9 # ################################################################################# package Webchat::Who; # Package name use Webchat::Dbm; # DBM handling use Webchat::Param; # Parameter handler use Webchat::Login; # Login handler ################################################################################# # Data Members ################################################################################# ################################################################################# # Sub-Routines ################################################################################# ##################### # Who # # Simply lists who is on at the time sub who # Database, CGI, Parameter list { ##################### # Data members my $Database = shift; # Database handle my $cgi = shift; # CGI handle my $param = shift; # Parameter list my $choice = shift; # Choice of the matter my $entries; # Amount of entries my $realm; # Realms title my $color = 0; # Colour change my $delay; # Timestamp delay my @who; # Who is on list my %realm; # Realm hash ##################### # Program area # Link DBM to hash Webchat::Dbm::DBMOpenRealm(\%realm); # Handle information $delay = (time - $realm{'SetTimeout'}); $param->{'ROOM'} = Webchat::Login::Unmangle($param->{'ROOM'}); # Retreive and format values for who is on Webchat::Database::GetListWho($Database, \@who, $param->{'ROOM'}, $delay); my $entries = @who; # Amount of entries # HTML Display # Title only if displayed if ($choice == 0) { # Prepare and display title $realm = $realm{'TagTitleRealm'}; # As to not change DBM $realm =~ s/REALM/$param->{'ROOM'}/g; # Replace REALM with real name print "$realm\n
\n"; # Display realm } # Table top print "
\n\n"; # If used as an Entrance if ($choice == 0) { print "\t\n"; # Row print "\t\t", $cgi->start_form('POST', $realm{'LnkRealm'}, 'application/x-www-form-urlencoded'); print "\t\t\n"; # End of column Webchat::Param::EmbedNormal($Database, $cgi, $param); print "\t\t", $cgi->end_form(), "\n"; # End of form } # Format line foreach $_ (@who) { # Use of tag if ($choice != 0) { print "\t\n"; } # Row tag else { $choice = 1; } # Alternate # Secondary colour if ($color == 0) { # Print then alternate to other colour print "\t\t\n"; $color = 1; # Alternate } # Secondary colour elsif ($color == 1) { # Print then alternate to other colour print "\t\t\n"; $color = 0; # Alternate } print "\t\n"; # Ending row tag } print "
"; # Column with button print $cgi->submit($realm{'TxtSubmit'}); # Button print "
"; print "$_"; print "$_
\n
\n"; # End of table # Unlink DBM to hash Webchat::Dbm::DBMClose(\%realm); } # Alias for Entrace sub WhoEntrance { who(shift, shift, shift, 0); } # Alias for Normal sub WhoNormal { who(shift, shift, shift, 1);} 1; # Return true ethereal-1.0.0/webchat/Post.pm100644 0 0 17323 7053646576 14330 0ustar rootroot#!/bin/perl ################################################################################# # Created : Martin Foster # Modified : 01/28/2000 ################################################################################# # # Post - Module part of Webchat designed to display posts based on information # Copyright (C) 2000 Martin Foster # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # # Author of this script can be contacted at the following: # E-Mail : mfoster@redwhite.com # Address : Suite 209 - 355 5th Ave NE # Calgary, Alberta # T2R 0K9 # ################################################################################# package Webchat::Post; # Package name use strict; # Strict variable enforcement use Webchat::Database; # Database handler use Webchat::Dbm; # DBM Addition use Webchat::Login; # Login functionality ################################################################################# # Data Members ################################################################################# ################################################################################# # Program Area ################################################################################# ################################################################################# # Sub-Routines ################################################################################# ##################### # GetPosts # # Using basic information about the user will return a Statement handle (more # lightweight then an array) that will be used in the display the information # gathered. sub GetPosts # Database, Statement reference, Parameters { ##################### # Data members my $Database = shift; # Database handle my $Statement = shift; # Statement handle (reference) my $param = shift; # Parameter list my $formatting; # Formatting used my $delay; # Delay to retreive posts my $ignored; # Ignored person my %realm; # Portal HASH ##################### # Program area # Determine time delay unless (defined($param->{'NUM'})) { Webchat::Dbm::DBMOpenRealm(\%realm); # Link with hash $delay = (time - $realm{'SetTimeout'}); # Determin value Webchat::Dbm::DBMClose(\%realm); # Unlink from hash } # Unmangle information $param->{'USER'} = Webchat::Login::Unmangle($param->{'USER'}); $param->{'ROOM'} = Webchat::Login::Unmangle($param->{'ROOM'}); $param->{'CHAR'} = Webchat::Login::Unmangle($param->{'CHAR'}); # Format handling # Retreive formatting used ($formatting) = Webchat::Database::DataGetFormatting($Database, $param->{'USER'}); # Determin field to use if ($formatting eq 'complete') # Full formatting { $formatting = 'PostFullFormat'; } elsif ($formatting eq 'spartan') # Spartan formatting { $formatting = 'PostPartialFormat'; } elsif ($formatting eq 'imageless') # Full less images { $formatting = 'PostImagelessFormat'; } # List of ignored $ignored = IgnoreHandler($Database, $param); # Number based search if (defined($param->{'NUM'})) { # Initialize and execute ${ $Statement } = $Database->prepare("SELECT PostIDNumber, $formatting FROM Post WHERE PostIDNumber > ? AND RealmName=? AND (PostTo='all' OR PostTo=?) $ignored"); ${ $Statement }->execute($param->{'NUM'}, $param->{'ROOM'}, $param->{'USER'}); } # Time based search else { # Initialize and execute ${ $Statement } = $Database->prepare("SELECT PostIDNumber, $formatting FROM Post WHERE PostTimeStamp > ? AND RealmName=? AND (PostTo='all' OR PostTo=?) $ignored"); ${ $Statement }->execute($delay, $param->{'ROOM'}, $param->{'USER'}); } } ##################### # Handle Posts # # Will display all retreived posts to screen, a fairly straightforward # operation, will also give a value to NUM once it knows the last post # received sub HandlePosts # Database, Parameters { ##################### # Data members my $Database = shift; # Database handle my $Statement; # Statement handle (reference) my $param = shift; # Parameter list my $post; # Post itself my $postnum; # Post number my %chat; # Chat hash ##################### # Program area # Link hash with DBM Webchat::Dbm::DBMOpenChat(\%chat); # Retreive posts GetPosts($Database, \$Statement, $param); # Run though posts and print while ( ($_, $post) = $Statement->fetchrow() ) { print "$chat{'TagSeperator'}"; # Seperator line print $post; # Display post $postnum = $_; # Give value to postnum } # Finish query $Statement->finish(); # Change value of NUM or define if (defined($postnum)) { $param->{'NUM'} = ($postnum - 1); } # Link hash with DBM Webchat::Dbm::DBMClose(\%chat); } ##################### # Handle Stream # # Will display all retreived posts to screen, a fairly straightforward # operation. This unlike HandlePosts will not stop until the stream # is ended sub HandleStream { ##################### # Data members my $Database = shift; # Database handle my $Statement; # Statement handle (reference) my $param = shift; # Parameter list my $choice = shift; # Choice of the matter my $post; # Post itself my $postnum; # Post number my $size = 0; # Size of posts my %chat; # Chat hash ##################### # Program area # Assign seperator Webchat::Dbm::DBMOpenChat(\%chat); my $seperator = $chat{'TagSeperator'}; Webchat::Dbm::DBMClose(\%chat); while ($size < 5000000) { # Retreive posts GetPosts($Database, \$Statement, $param); # Run though posts and print while ( ($_, $post) = $Statement->fetchrow() ) { # Display print "$seperator"; # Seperator line print $post; # Display post # Assignment $postnum = $_; # Give value to postnum $size = $size + ($post =~ tr/a-zA-Z0-9*:()\/\\//); } # Finish query $Statement->finish(); # Change value of NUM or define if (defined($postnum)) { $param->{'NUM'} = ($postnum); } sleep(5); # Sleep till next pass } } ##################### # Ignore Handler # # Will create a string to append to the end of the SQL statement, as # to ignore the specified list of people. sub IgnoreHandler # Database, Parameters { ##################### # Data members my $Database = shift; # Database handle my $Statement; # Statement handle (reference) my $param = shift; # Parameter list my $string; # Ignored string my $ignored; # Ignored person my @ignored; # Ignored group ##################### # Program area # Retreive list of the damned Webchat::Database::GetListPuppetIgnored($Database, \@ignored, Webchat::Login::Unmangle($param->{'USER'})); # As long as there are entries while ($ignored = shift @ignored) { # If the string is defined if (defined($string)) { $string = "$string AND PuppetName <> '$ignored'"; } # Initialize for next pass else { $string = " AND PuppetName <> '$ignored'"; } } # Checks before returning if (defined($string)) { return $string; } # Return string else # Empty string { return ' '; } } 1; # Return true ethereal-1.0.0/webchat/Login.pm100644 0 0 30051 7053646576 14444 0ustar rootroot################################################################################# # Created : Martin Foster # Modified : 01/14/2000 ################################################################################# # # Login - Modules part of Webchat designed to simplify login # Copyright (C) 2000 Martin Foster # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # # Author of this script can be contacted at the following: # E-Mail : mfoster@redwhite.com # Address : Suite 209 - 355 5th Ave NE # Calgary, Alberta # T2R 0K9 # ################################################################################# package Webchat::Login; # Package name use Webchat::Dbm; # DBM Addition use Webchat::Table; # Table Creation ################################################################################# # Data Members ################################################################################# ################################################################################# # Sub-Routines ################################################################################# ##################### # Authenthication # # This is the primary component of this module, and this would be the # authenthication script, which will verify usernames and passwords. sub Authenthication # Database, Parameter hash, Choice { ##################### # Data members my $Database = shift; # Database handle my $Statement; # SQL statement handle my $param = shift; # Parameter list my $choice = shift; # Choice of matter my $crypt; # Crypted password my $check; # Check registration my %login; # Login dbm ##################### # Program area # Unmangle username $param->{'USER'} = Unmangle($param->{'USER'}); # Prepare and execute if ($choice != 0) # Adminstrative { $Statement = $Database->prepare("SELECT PuppeteerPassword FROM Puppeteer WHERE PuppeteerLogin=? AND PuppeteerAdminPrivs='yes'"); } else # Non-Authoritative { $Statement = $Database->prepare("SELECT PuppeteerPassword FROM Puppeteer WHERE PuppeteerLogin=?"); } $Statement->execute($param->{'USER'}); # Retreive and finish $crypt = $Statement->fetchrow(); $Statement->finish(); # Compare passwords if (defined($crypt)) { # If crypt if (defined($param->{'CRYPT'})) { # Fail on non-match if ($param->{'CRYPT'} ne $crypt) { return 0; } } # If first time elsif (defined($param->{'PASS'})) { # Fail on non-match if (crypt($param->{'PASS'}, $crypt) ne $crypt) { return 0; } } # Assume fault else { return 0; } } # Assume fault else { return 0; } # Verify for incomplete registration # Prepare and execute $Statement = $Database->prepare("SELECT PuppeteerLogin FROM PuppeteerRegistration WHERE PuppeteerLogin=?"); $Statement->execute($param->{'USER'}); # Retreive and finish $check = $Statement->fetchrow(); $Statement->finish(); # Check if registration is complete if (defined($check)) { return 0; } # Or return false # Database updates # If non-authoritative if (defined($param->{'JAVA'})) { ##################### # Data members my $radiojava; # Formated javascript my $radiochat; # Formatted chat preferences my $radioformat; # Formatted format options # Verify options received Webchat::Dbm::DBMOpenLogin(\%login); $radiojava = OptionFindJavascript($login{'OptJavascript'}, $param->{'JAVA'}); $radiochat = OptionFindChatprefs($login{'OptChatPref'}, $param->{'CHAT'}); $radioformat = OptionFindFormatting($login{'OptFormat'}, $param->{'FORMAT'}); Webchat::Dbm::DBMClose(\%login); # Javascript options if ($radiojava ne 'default') { # Update database entry $Database->do("UPDATE Puppeteer SET PuppeteerJavascript=? WHERE PuppeteerLogin=?", {}, $radiojava, $param->{'USER'}); } # Chatting options if ($radiochat ne 'default') { # Update database entry $Database->do("UPDATE Puppeteer SET PuppeteerChatPref=? WHERE PuppeteerLogin=?", {}, $radiochat, $param->{'USER'}); } # Formatting options if ($radioformat ne 'default') { # Update database entry $Database->do("UPDATE Puppeteer SET PuppeteerFormatting=? WHERE PuppeteerLogin=?", {}, $radioformat, $param->{'USER'}); } } # Update database entry update timestamp $Database->do("UPDATE Puppeteer SET PuppeteerTimestamp=? WHERE PuppeteerLogin=?", {}, time, $param->{'USER'}); return 1; # Return true } ##################### # GatherInfo # # Sub-routine that will handle the display of information, comes in two flavors # adminstrative and non-authoritative login. Selected though alias. sub GatherInfo # CGI, Parameter hash, Choice { ##################### # Data members my $cgi = shift; # CGI Handle my $param = shift; # Parameter list my $choice = shift; # Choice on the matter my %login; # Login hash ##################### # Program area Webchat::Dbm::DBMOpenLogin(\%login); # Open login dbm # Print titles if ($choice != 1) # Non-authoritative { print "$login{'TagTitleGeneral'}\n
\n"; } else # Adminstrative { print "$login{'TagTitleAdmin'}\n
\n"; } print $cgi->start_form(); # Start form Webchat::Table::MakeTop($cgi); # Top of table # Username and password Webchat::Table::MakeValid($cgi, $login{'TagUsername'}, $cgi->textfield('USER', '', 15, 10)); Webchat::Table::MakeValid($cgi, $login{'TagPassword'}, $cgi->password_field('PASS', '', 15, 8)); Webchat::Table::MakeBlank($cgi); # Spacer # If non admistrative if ($choice != 1) { ##################### # Data members my $radiojava; # Formated javascript my $radiochat; # Formatted chat preferences my $radioformat; # Formatted format options my @radiojava; # Javascript options my @radiochat; # Chat options my @radioformat; # Formatting options # Split data into arrays OptionSplit(\@radiojava, $login{'OptJavascript'}); OptionSplit(\@radiochat, $login{'OptChatPref'}); OptionSplit(\@radioformat, $login{'OptFormat'}); # Format options nicely $radiojava = $cgi->radio_group('JAVA', \@radiojava, $radiojava[2], 'true'); $radiochat = $cgi->radio_group('CHAT', \@radiochat, $radiochat[3], 'true'); $radioformat = $cgi->radio_group('FORMAT', \@radioformat, $radioformat[3], 'true'); # Javascript Webchat::Table::MakeValid($cgi, $login{'TagOptJavacript'}, $radiojava); Webchat::Table::MakeBlank($cgi); # Spacer # Chat preferences Webchat::Table::MakeValid($cgi, $login{'TagOptChatPref'}, $radiochat); Webchat::Table::MakeBlank($cgi); # Spacer # Format options Webchat::Table::MakeValid($cgi, $login{'TagOptFormat'}, $radioformat); Webchat::Table::MakeBlank($cgi); # Spacer } # Submit and table bottom Webchat::Table::MakeValid($cgi, $cgi->submit($login{'TxtSubmitButton'}), $cgi->reset($login{'TxtResetButton'})); Webchat::Table::MakeBottom($cgi); print $cgi->end_form(); # End of form Webchat::Dbm::DBMClose(\%login); # Close DBM } ##################### # Get Verification # # Primary entrance which will lead to GatherInfo or Authenthication depending # on received parameters. sub GetVerification # Database, CGI, Parameter, Choice { ##################### # Data members my $Database = shift; # Database handle my $cgi = shift; # CGI handle my $param = shift; # Parameter reference my $choice = shift; # Decision to make ##################### # Program area # Verify is necessary components are there if ((defined($param->{'USER'})) && ((defined($param->{'PASS'})) || (defined($param->{'CRYPT'})))) { if (Authenthication($Database, $param, $choice)) { return 1; } # Return true } GatherInfo($cgi, $param, $choice); # Reshow login return 0; # Return false } # Alias for administrative sub GetVerificationAdmin { GetVerification(shift, shift, shift, 1); } # Alias for normal sub GetVerificationNormal { GetVerification(shift, shift, shift, 0); } ##################### # OptionSplit # # Splits options list into seperate elements of array sub OptionSplit { ##################### # Data members my $array = shift; # Reference to array my $data = shift; # Retreived line ##################### # Program area @{ $array } = split(/:/, $data); # Split line } ##################### # OptionFind # # Splits options list into seperate elements of array and determines which # option was specifically selected for the database sub OptionFind { ##################### # Data members my $string = shift; # String with all options my $val = shift; # Value to search for my $choice = shift; # Flow of events my $counter = 0; # Basic counter my @values; # Array of values ##################### # Program area OptionSplit(\@values, $string); # Split options\receive values # Loop though array while ($string = shift @values) { # Verify for match if ($string eq $val) { last; } # If found exit loop $counter++; # Increment if no match found } # Javascript Options/Yes no Options if ($choice == 0) { # Which option applies if ($counter == 0) { return 'yes'; } elsif ($counter == 1) { return 'no'; } } # Chat preferences elsif ($choice == 1) { # Which option applies if ($counter == 0) { return 'basic'; } elsif ($counter == 1) { return 'framed'; } elsif ($counter == 2) { return 'stream'; } } # Format used in chat elsif ($choice == 2) { # Which option applies if ($counter == 0) { return 'complete'; } elsif ($counter == 1) { return 'imageless'; } elsif ($counter == 2) { return 'spartan'; } } return 'default'; } # Alias for Javascript sub OptionFindJavascript { return OptionFind(shift, shift, 0); } # Alias for Chat preferences sub OptionFindChatprefs { return OptionFind(shift, shift, 1); } # Alias for Formatting sub OptionFindFormatting { return OptionFind(shift, shift, 2); } ##################### # Remangle # # Mangles the text, by adding underscores replacing the orginial spaces that # were found in the various titles. sub Remangle # Word { ##################### # Data members my $word = shift; # Word ##################### # Program area # Unmangle if defined if ( defined($word) ) { $word =~ s/\s/_/g; } # Return word return $word; } ##################### # Unmangle # # Unmangles text, by removing underscores and replacing them with more normal # spaces. Otherwise MySQL and other such tests will fail. sub Unmangle # Word { ##################### # Data members my $word = shift; # Word ##################### # Program area # Unmangle if defined if ( defined($word) ) { $word =~ s/_/ /g; } # Return word return $word; } 1; # Return true ethereal-1.0.0/admin/ 40755 0 0 0 7053646576 12375 5ustar rootrootethereal-1.0.0/admin/realmadmin.plx100755 0 0 23260 7053646576 15356 0ustar rootroot#!/bin/perl -w ################################################################################# # Created : Martin Foster # Modified : 01/17/2000 ################################################################################# # # Realm Configuration - Script part of Webchat designed to add/remove realms # Copyright (C) 2000 Martin Foster # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # # Author of this script can be contacted at the following: # E-Mail : mfoster@redwhite.com # Address : Suite 209 - 355 5th Ave NE # Calgary, Alberta # T2R 0K9 # ################################################################################# use CGI qw(:standard); # Common gateway interface use CGI::Carp qw(fatalsToBrowser); # CGI Error logs use strict; # Strict variable enforcement use Webchat::Database; # Database handler use Webchat::Dbm; # DBM Addition use Webchat::Login; # Login functionality use Webchat::Param; # Parameter control use Webchat::Table; # Table handle ################################################################################# # Data Members ################################################################################# my $Database; # Database handle my $cgi; # Common gateway interface handle my %config; # System hash my %param; # Parameter hash ################################################################################# # Program Area ################################################################################# $cgi = new CGI; # Create CGI Handle Webchat::Database::DatabaseConnect(\$Database); # Connect to MySQL Webchat::Param::GetParam($cgi, \%param); # Retreive parameters print $cgi->header(); # File header print $cgi->start_html('Realm Administration'); # HTML header # Login if (Webchat::Login::GetVerificationAdmin($Database, $cgi, \%param)) { print $cgi->h1('Realm Administration'), "\n"; # Document title # Initial check for type of search unless ( defined($param{'REALMTYPE'}) ) { # Allow user to select type of realm RealmType($Database, $cgi, \%param); RealmAddition($Database, $cgi, \%param); } # If defined elsif ( defined($param{'REALMTYPE'}) ) { # Display realms RealmDisplay($Database, $cgi, \%param); # Allow user to select type of realm RealmType($Database, $cgi, \%param); RealmAddition($Database, $cgi, \%param); } } print $cgi->end_html(); # HTML footer $Database->disconnect(); # Disconnect from database ################################################################################# # Sub-Routines ################################################################################# ##################### # Realm Addition # # Sub-routine that displays additions of new realms. sub RealmAddition { ##################### # Data members my $Database = shift; # Database handle my $cgi = shift; # CGI handle my $param = shift; # Parameter list my @radiolang = qw(relaxed restricted); # Language my @radioaccess = qw(relaxed restricted list); # Access my @radioguest = qw(yes no post); # Guests my @radiotags = qw(relaxed restricted); # Tags # Initialize radio buttons my $radiolang = $cgi->radio_group('NEWLANG', \@radiolang, $radiolang[0], 'true'); my $radioaccess = $cgi->radio_group('NEWACCESS',\@radioaccess,$radioaccess[0],'true'); my $radioguest = $cgi->radio_group('NEWGUEST', \@radioguest, $radioguest[0], 'true'); my $radiotags = $cgi->radio_group('NEWTAGS', \@radiotags, $radiotags[0], 'true'); ##################### # Program area print "\t", $cgi->hr, "\n"; # Horizontal row print $cgi->start_form(); # Begnning HTML form # Prompt and display realm name Webchat::Table::MakeTop($cgi); Webchat::Table::MakeValid($cgi, 'Realm Name', $cgi->textfield('NEWNAME' , '', 20, 30)); Webchat::Table::MakeValid($cgi, 'Image Height', $cgi->textfield('NEWHEIGHT', '0', 20, 5)); Webchat::Table::MakeValid($cgi, 'Image Width', $cgi->textfield('NEWWIDTH' , '0', 20, 5)); Webchat::Table::MakeBlank($cgi); # Spacer # Language selection Webchat::Table::MakeValid($cgi, 'Language', $radiolang); Webchat::Table::MakeBlank($cgi); # Spacer # Access type Webchat::Table::MakeValid($cgi, 'Access type', $radioaccess); Webchat::Table::MakeBlank($cgi); # Spacer # Guest access Webchat::Table::MakeValid($cgi, 'Guest Access', $radioguest); Webchat::Table::MakeBlank($cgi); # Spacer # Tag enforcement Webchat::Table::MakeValid($cgi, 'Tag enforcement', $radiotags); Webchat::Table::MakeBlank($cgi); # Spacer # Submit and reset Webchat::Table::MakeValid($cgi, $cgi->submit('Add'), $cgi->reset('Clear')); Webchat::Table::MakeBottom($cgi); Webchat::Param::EmbedNormal($Database, $cgi, $param); print "\t", $cgi->hidden('REALMTYPE', 'yes'), "\n"; print $cgi->end_form(), "\n"; # Ending HTML form print "\t", $cgi->hr, "\n"; # Horizontal row } ##################### # RealmDisplay # # Sub-routine that will display and handle basic operations reguarding direction # of calls. As in remove and additions. sub RealmDisplay { ##################### # Data members my $Database = shift; # Database handle my $Statement; # Statement shift my $cgi = shift; # CGI handle my $param = shift; # Parameter list reference my $color = 0; # Colour changer my @values; # Received values ##################### # Program area # Data removal if (defined( $param->{'DELETE'} )) { # Remove from satellite tables $Database->do("DELETE FROM PuppeteerRestriction WHERE RealmName=?", {}, $param->{'DELETE'}); $Database->do("DELETE FROM PuppetInvitation WHERE RealmName=?", {}, $param->{'DELETE'}); $Database->do("DELETE FROM RealmSupervisor WHERE RealmName=?", {}, $param->{'DELETE'}); $Database->do("DELETE FROM WordRestriction WHERE RealmName=?", {}, $param->{'DELETE'}); # Delete parent table $Database->do("DELETE FROM Realm WHERE RealmName=?", {}, $param->{'DELETE'}); } # Data addition if (defined( $param->{'NEWNAME'} )) { # Execute $Database->do("INSERT INTO Realm VALUES (?,?,?,?,'yes',?,NULL,NULL,NULL,NULL,?,?,?)", {}, $param->{'NEWNAME'}, $param->{'NEWLANG'}, $param->{'NEWACCESS'}, $param->{'NEWGUEST'}, $param->{'NEWTAGS'}, $param->{'NEWHEIGHT'}, $param->{'NEWWIDTH'}, time); } # Data viewing # Prepare and execute $Statement = $Database->prepare("SELECT RealmName, RealmLanguage, RealmAccess, RealmGuests, RealmTags, RealmTimestamp FROM Realm WHERE RealmPublic=? ORDER BY RealmName"); $Statement->execute($param->{'REALMTYPE'}); print ""; # Display header print "\t\n"; print "\t\t\n"; print "\t\t\n"; print "\t\t\n"; print "\t\t\n"; print "\t\t\n"; print "\t\t\n"; print "\t\t\n"; print "\t\n"; # Fetch rows of data while (@values = $Statement->fetchrow()) { # Determin colour of row if ($color != 0) # White { print "\t\n"; $color = 0; } else # Pale grey { print "\t\n"; $color = 1; } print "\t\t\n"; print "\t\t\n"; print "\t\t\n"; print "\t\t\n"; print "\t\t\n"; print "\t\t\n"; print "\t\t", $cgi->start_form(); # Start form print "\t\t", $cgi->hidden('REALMTYPE', $param->{'REALMTYPE'}), "\n"; print "\t\t", $cgi->hidden('DELETE', $values[0]), "\n"; Webchat::Param::EmbedNormal($Database, $cgi, $param); print "\t\t\n"; print "\t\t", $cgi->end_form(), "\n"; # End form print "\t\n"; # End row } $Statement->finish(); # Finish SQL statement print "
Realm NameLanguageAccessGuestsTagsTimestamp
$values[0]$values[1]$values[2]$values[3]$values[4]$values[5]\n"; print "\t\t\t", $cgi->submit('Remove'), "\n"; print "\t\t
\n"; # End of table } ##################### # Realm Type # # Simply allows the user to determine which type of rooms to view private or # public based on a simple statement. sub RealmType # Database, CGI { ##################### # Data members my $Database = shift; # Database handle my $cgi = shift; # CGI handle my $param = shift; # Parameter list my $list; my @list = qw(yes no); # List of choices ##################### # Program area print "\t", $cgi->hr, "\n"; # Horizontal row print $cgi->start_form(); # Begnning HTML form # Prepare list $list = $cgi->radio_group('REALMTYPE', \@list, $list[0], 'true'); # Prompt and Display Document choices Webchat::Table::MakeTop($cgi); Webchat::Table::MakeValid($cgi, 'Public Realm', $list); Webchat::Table::MakeBlank($cgi); # Spacer Webchat::Table::MakeValid($cgi, $cgi->submit('List Realms'), ' '); Webchat::Table::MakeBottom($cgi); Webchat::Param::EmbedNormal($Database, $cgi, $param); print $cgi->end_form(), "\n"; # Ending HTML form } ethereal-1.0.0/admin/useradmin.plx100755 0 0 31771 7053646576 15242 0ustar rootroot#!/bin/perl -w ################################################################################# # Created : Martin Foster # Modified : 01/14/2000 ################################################################################# # # User Configuration - Script part of Webchat designed to modify user information # rights. Contains comprehensive search parameter. # Copyright (C) 2000 Martin Foster # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # # Author of this script can be contacted at the following: # E-Mail : mfoster@redwhite.com # Address : Suite 209 - 355 5th Ave NE # Calgary, Alberta # T2R 0K9 # ################################################################################# use CGI qw(:standard); # Common gateway interface use CGI::Carp qw(fatalsToBrowser); # CGI Error logs use strict; # Strict variable enforcement use Webchat::Database; # Database handler use Webchat::Dbm; # DBM Addition use Webchat::Login; # Login functionality use Webchat::Param; # Parameter control use Webchat::Table; # Table control ################################################################################# # Data Members ################################################################################# my $Database; # Database handle my $cgi; # Common gateway interface handle my %config; # System hash my %param; # Parameter hash ################################################################################# # Program Area ################################################################################# $cgi = new CGI; # Create CGI Handle Webchat::Database::DatabaseConnect(\$Database); # Connect to MySQL Webchat::Param::GetParam($cgi, \%param); # Retreive parameters print $cgi->header(); # File header print $cgi->start_html('User Administration'); # HTML header # Verification of login before admin screens if (Webchat::Login::GetVerificationAdmin($Database, $cgi, \%param)) { print $cgi->h1('User Administration'), "\n"; # Document title # Basic search prompt if ((!defined($param{'RANGE'})) && (!defined($param{'FIELD'})) && (!defined($param{'LOGIN'}))) { UserSearch($Database, $cgi, \%param); } # Basic search with user selection and removal elsif (!defined($param{'LOGIN'})) { UserSelect($Database, $cgi, \%param); UserSearch($Database, $cgi, \%param); } # Handles the primary modifications of a user elsif (defined($param{'LOGIN'})) { UserModify($Database, $cgi, \%param); UserSearch($Database, $cgi, \%param); } } print $cgi->end_html(); # HTML footer $Database->disconnect(); # Disconnect from database ################################################################################# # Sub-Routines ################################################################################# ##################### # SQL Handler # # Looks at parameters and returns a formatted SQL statement to be used for searches sub SqlHandler # Parameter Hash { ##################### # Data members my $param = shift; # Parameter hash my $sql; # SQL query my @range = qw(Administrators Supervisors Non-Priviledged All-Encompasing); my @field = qw(E-Mail Login Name); ##################### # Program area $sql = 'SELECT PuppeteerLogin, PuppeteerName, PuppeteerEMail FROM Puppeteer'; # Build SQL query # Admin privs if ($param->{'RANGE'} eq $range[0]) { $sql = "$sql WHERE PuppeteerAdminPrivs='yes'"; } # Supervisor privs elsif ($param->{'RANGE'} eq $range[1]) { $sql = "$sql WHERE PuppeteerSuperPrivs='yes'"; } # Non-Priviledged users elsif ($param->{'RANGE'} eq $range[2]) { $sql = "$sql WHERE PuppeteerSuperPrivs='no' AND PuppeteerAdminPrivs='no'"; } # Only complete following if nothing (or near to) in keywords unless (($param->{'KEYWORD'} =~ tr/A-Za-z1-9@//) < 3) { # Addition of AND if WHERE is already applied unless ($param->{'RANGE'} eq $range[3]) { $sql = "$sql AND"; } else { $sql = "$sql WHERE"; } # Field selection # E-Mail field search if ($param->{'FIELD'} eq $field[0]) { $sql = "$sql PuppeteerEMail"; } # Login name search elsif ($param->{'FIELD'} eq $field[1]) { $sql = "$sql PuppeteerLogin"; } # Full name search elsif ($param->{'FIELD'} eq $field[2]) { $sql = "$sql PuppeteerName"; } # Completion of SQL statement $sql = "$sql LIKE '\%$param->{'KEYWORD'}\%'"; } return "$sql ORDER BY PuppeteerLogin"; # Return statement to parent } ##################### # User Modify # # Will either prompt for information or make changes and list the changed # values to the user. Only one value can be changed at a time. sub UserModify # Database, CGI, Parameter reference { ##################### # Data members my $Database = shift; # Database handle my $Statement; # Statement handle my $cgi = shift; # CGI handle my $param = shift; # Parameter reference my $radioadmin; # Radio adminstration my $radiosuper; # Radio supervisory my $login; # Login name my @values; # Array of my @choices = qw(yes no); # Yes or no ##################### # Program area # Change username to normal $login = $param->{'LOGIN'}; $login =~ s/_/ /g; # If save then save if (defined($param->{'SAVE'})) # Saved parameters { # Make changes $Database->do("UPDATE Puppeteer SET PuppeteerPassword=?, PuppeteerName=?, PuppeteerEMail=?, PuppeteerAdminPrivs=?, PuppeteerSuperPrivs=? WHERE PuppeteerLogin=?", {}, $param->{'PASSWORD'}, $param->{'FULLNAME'}, $param->{'EMAIL'}, $param->{'ADMIN'}, $param->{'SUPER'}, $login ); } # Data display # Prepare and execute $Statement = $Database->prepare("SELECT * FROM Puppeteer WHERE PuppeteerLogin=?"); $Statement->execute($login); @values = $Statement->fetchrow(); $Statement->finish(); print $cgi->start_form(), "\n"; # Start of form Webchat::Table::MakeTop($cgi); # Table top # Login, Password, Name and EMail Webchat::Table::MakeValid($cgi, 'Login Name', "$values[0]"); Webchat::Table::MakeValid($cgi, 'Password', $cgi->textfield('PASSWORD', $values[1], 25, 13)); Webchat::Table::MakeValid($cgi, 'Full Name', $cgi->textfield('FULLNAME', $values[2], 25, 30)); Webchat::Table::MakeValid($cgi, 'E-Mail', $cgi->textfield('EMAIL', $values[3], 25, 45)); Webchat::Table::MakeBlank($cgi); # Timestamp, Formatting, Chat Prefs and Javascript (cannot be changed) Webchat::Table::MakeValid($cgi, 'Timestamp ', "$values[4]"); Webchat::Table::MakeValid($cgi, 'Formatting', "$values[5]"); Webchat::Table::MakeValid($cgi, 'Chat Prefs', "$values[6]"); Webchat::Table::MakeValid($cgi, 'Javascript', "$values[7]"); Webchat::Table::MakeBlank($cgi); # Preperation of radio button labels $radioadmin = $cgi->radio_group('ADMIN', \@choices, $values[8]); $radiosuper = $cgi->radio_group('SUPER', \@choices, $values[9]); # Adminstrative and Supervisory controls Webchat::Table::MakeValid($cgi, 'Administrative', $radioadmin); Webchat::Table::MakeValid($cgi, 'Supervisory ', $radiosuper); Webchat::Table::MakeBlank($cgi); # Submit and Reset Webchat::Table::MakeValid($cgi, $cgi->submit('Change'), $cgi->reset('Reset')); Webchat::Table::MakeBottom($cgi); # Embed login information Webchat::Param::EmbedNormal($Database, $cgi, $param); print "\n", $cgi->hidden('LOGIN', $param->{'LOGIN'}), "\n"; print "\n", $cgi->hidden('SAVE', 'Aye'), "\n"; print $cgi->end_form(), "\n"; # End of form print "\n"; # End table/row } ##################### # User Search # # Allows one to select range of users to select, Admin, Supervisors, et cetera sub UserSearch # Database, CGI { ##################### # Data members my $Database = shift; # Database handle my $cgi = shift; # CGI handle my $param = shift; # Parameter list # Range selection label # Must not be changed my @range = qw(Administrators Supervisors Non-Priviledged All-Encompasing); my @field = qw(E-Mail Login Name); my $radiorange; # Range radio button my $radiofield; # Field ratio button ##################### # Program area print $cgi->hr(), "\n"; # Horizontal row print $cgi->start_form(); # Begnning HTML form $radiorange = $cgi->radio_group('RANGE', \@range, $range[3], 'true'); $radiofield = $cgi->radio_group('FIELD', \@field, $field[0], 'true'); Webchat::Table::MakeTop($cgi); # Table Top # Search Range Webchat::Table::MakeValid($cgi, 'Search Range', $radiorange); Webchat::Table::MakeBlank($cgi); # Spacer # Field and keyword Webchat::Table::MakeValid($cgi, 'Search Field', $radiofield); Webchat::Table::MakeValid($cgi, 'Search Words', $cgi->textfield('KEYWORD', '', 25, 25)); Webchat::Table::MakeBlank($cgi); # Spacer # Submit and bottom Webchat::Table::MakeValid($cgi, $cgi->submit('Search'), ''); Webchat::Table::MakeBottom($cgi); # Embed login information Webchat::Param::EmbedNormal($Database, $cgi, $param); print $cgi->end_form(), "\n"; # Ending HTML form print $cgi->hr(), "\n"; # Horizontal row } ##################### # User Select # # Displays initial query and allows to select individual user sub UserSelect # Database, CGI, Parameter List { ##################### # Data members my $Database = shift; # Database handle my $Statement; # Statement shift my $query = SqlHandler(\%param); # SQL Query my $cgi = shift; # CGI handle my $param = shift; # Parameter list reference my $color = 0; # Colour changer my @values; # Received values ##################### # Program area # If defined, remove if (defined($param->{'DELETE'})) { # Return to orginal condition my $login = Webchat::Login::Unmangle($param->{'DELETE'}); # Remove Puppets $Statement = $Database->prepare("SELECT PuppetName FROM Puppet WHERE PuppeteerLogin=?"); $Statement->execute($login); # Clense database of puppets while ($_ = $Statement->fetchrow()) { $Database->do("DELETE FROM PuppetInvitation WHERE PuppetName=?", {}, $_); $Database->do("DELETE FROM PuppetIgnore WHERE PuppetName=?", {}, $_); } # Remove puppeteer from tables $Database->do("DELETE FROM RealmSupervisor WHERE PuppeteerLogin=?", {}, $login); $Database->do("DELETE FROM PuppetIgnore WHERE PuppeteerLogin=?", {}, $login); $Database->do("DELETE FROM PuppeteerRegistration WHERE PuppeteerLogin=?", {}, $login); $Database->do("DELETE FROM PuppeteerRestriction WHERE PuppeteerLogin=?", {}, $login); $Database->do("DELETE FROM Puppet WHERE PuppeteerLogin=?", {}, $login); $Database->do("DELETE FROM Puppeteer WHERE PuppeteerLogin=?", {}, $login); } # Data gathering and display # Prepare and execute $Statement = $Database->prepare($query); $Statement->execute(); print ""; # Display header print "\t\n"; print "\t\t\n"; print "\t\t\n"; print "\t\t\n"; print "\t\t\n"; print "\t\t\n"; print "\t\n"; # Fetch rows of data while (@values = $Statement->fetchrow()) { # Determin colour of row if ($color != 0) { print "\t\n"; $color = 0; } else { print "\t\n"; $color = 1; } print "\t\t\n"; print "\t\t\n"; print "\t\t\n"; # Remove spaces $values[0] =~ s/\s/_/g; print "\t\t", $cgi->start_form(); # Start form print "\t\t\t", $cgi->hidden('LOGIN', $values[0]), "\n"; Webchat::Param::EmbedNormal($Database, $cgi, $param); print "\t\t\n"; print "\t\t", $cgi->end_form(), "\n"; # End form print "\t\t", $cgi->start_form(); # Start form print "\t\t\t", $cgi->hidden('RANGE', $param->{'RANGE'}), "\n"; print "\t\t\t", $cgi->hidden('FIELD', $param->{'FIELD'}), "\n"; print "\t\t\t", $cgi->hidden('KEYWORD', $param->{'KEYWORD'}), "\n"; print "\t\t\t", $cgi->hidden('DELETE', $values[0]), "\n"; Webchat::Param::EmbedNormal($Database, $cgi, $param); print "\t\t\n"; print "\t\t", $cgi->end_form(), "\n"; # End form print "\t\n"; # End row } $Statement->finish(); # Finish SQL statement print "
Login NameFull NameE-Mail address
$values[0]$values[1]$values[2]\n"; print "\t\t\t", $cgi->submit('Modify'), "\n"; print "\t\t\n"; print "\t\t\t", $cgi->submit('Remove'), "\n"; print "\t\t
\n"; # End of table } ethereal-1.0.0/admin/textadmin.plx100755 0 0 13145 7053646576 15243 0ustar rootroot#!/bin/perl -w ################################################################################# # Created : Martin Foster # Modified : 01/17/2000 ################################################################################# # # Text Configuration - Script part of Webchat designed to modify documents on database # Copyright (C) 2000 Martin Foster # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # # Author of this script can be contacted at the following: # E-Mail : mfoster@redwhite.com # Address : Suite 209 - 355 5th Ave NE # Calgary, Alberta # T2R 0K9 # ################################################################################# use CGI qw(:standard); # Common gateway interface use CGI::Carp qw(fatalsToBrowser); # CGI Error logs use strict; # Strict variable enforcement use Webchat::Database; # Database handler use Webchat::Dbm; # DBM Addition use Webchat::Login; # Login functionality use Webchat::Param; # Parameter control ################################################################################# # Data Members ################################################################################# my $Database; # Database handle my $cgi; # Common gateway interface handle my %config; # System hash my %param; # Parameter hash ################################################################################# # Program Area ################################################################################# $cgi = new CGI; # Create CGI Handle Webchat::Database::DatabaseConnect(\$Database); # Connect to MySQL Webchat::Param::GetParam($cgi, \%param); # Retreive parameters print $cgi->header(); # File header print $cgi->start_html('Document Administration'); # HTML header # Login if (Webchat::Login::GetVerificationAdmin($Database, $cgi, \%param)) { print $cgi->h1('Document Administration'), "\n";# Document title # If no DOCTYPE then list options if (!defined($param{'DOCTYPE'})) { DocumentSelect($Database, $cgi, \%param); } # If only DOCTYPE is specified then allow to modify elsif ((defined($param{'DOCTYPE'})) && (!defined($param{'DOCDATA'}))) { DocumentSelect($Database, $cgi, \%param); DocumentModify($Database, $cgi, \%param); } # If only DOCTYPE and DOCDATA are specified elsif ((defined($param{'DOCTYPE'})) && (defined($param{'DOCDATA'}))) { DocumentSelect($Database, $cgi, \%param); DocumentModify($Database, $cgi, \%param); } } print $cgi->end_html(); # HTML footer $Database->disconnect(); # Disconnect from database ################################################################################# # Sub-Routines ################################################################################# ##################### # Document Modify # # Simply modifies documents available and allows one to select them. sub DocumentModify # Database, CGI { ##################### # Data members my $Database = shift; # Database handle my $Statement; # Statement shift my $cgi = shift; # CGI handle my $param = shift; # Parameter list my $document; # Document ##################### # Program area # If defined save if (defined($param->{'DOCDATA'})) { $Database->do("UPDATE WebchatText SET WebchatTextContent=? WHERE WebchatTextName=?", {}, $param->{'DOCDATA'}, $param->{'DOCTYPE'}); } # Prepare and execute statement $Statement = $Database->prepare("SELECT WebchatTextContent FROM WebchatText WHERE WebchatTextName='$param->{'DOCTYPE'}'"); $Statement->execute(); # Retreive and finish $document = $Statement->fetchrow(); $Statement->finish(); print $cgi->start_form(); # Display HTML and information print "\tOpened document\n\t
\n"; print "\t", $cgi->textarea('DOCDATA', $document, 15, 100), "\n"; # Embed information Webchat::Param::EmbedNormal($Database, $cgi, $param); print "\t", $cgi->hidden('DOCTYPE', $param->{'DOCTYPE'}), "\n"; print "\t", $cgi->p($cgi->submit('Save Changes')), "\n"; print $cgi->end_form(), "\n"; } ##################### # DocumentSelect # # Simply lists documents available and allows one to select them. sub DocumentSelect # Database, CGI { ##################### # Data members my $Database = shift; # Database handle my $cgi = shift; # CGI handle my $param = shift; # Parameter list my @list; # List of fields ##################### # Program area # Retrieve list of documents Webchat::Database::GetListDocuments($Database, \@list); print "\t", $cgi->hr, "\n"; # Horizontal row print $cgi->start_form(); # Begnning HTML form # Prompt and Display Document choices print "\t", $cgi->p('Document list: ', $cgi->popup_menu('DOCTYPE', \@list)), "\n"; print "\t", $cgi->p($cgi->submit('Open Document')), "\n"; Webchat::Param::EmbedNormal($Database, $cgi, $param); print $cgi->end_form(), "\n"; # Ending HTML form print "\t", $cgi->hr, "\n"; # Horizontal row } ethereal-1.0.0/admin/chatadmin.plx100755 0 0 20314 7053646576 15172 0ustar rootroot#!/bin/perl -w ################################################################################# # Created : Martin Foster # Modified : 01/15/2000 ################################################################################# # # Chat configuration - Script part of Webchat designed to configure MySQL for use # Copyright (C) 2000 Martin Foster # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # # Author of this script can be contacted at the following: # E-Mail : mfoster@redwhite.com # Address : Suite 209 - 355 5th Ave NE # Calgary, Alberta # T2R 0K9 # ################################################################################# use CGI qw(:standard); # Common gateway interface use CGI::Carp qw(fatalsToBrowser); # CGI Error logs use strict; # Strict variable enforcement use Webchat::Database; # Database handler use Webchat::Dbm; # DBM Addition use Webchat::Login; # Login controls use Webchat::Param; # Parameter control ################################################################################# # Data Members ################################################################################# my $Database; # Database handle my $cgi; # CGI Handle my %param; # Parameter list ################################################################################# # Program Area ################################################################################# $cgi = new CGI; # New CGI handle Webchat::Param::GetParam($cgi, \%param); # Param to Hash Webchat::Database::DatabaseConnect(\$Database); # Connect to MySQL print $cgi->header(); # File header print $cgi->start_html('Webchat configuration'); # HTML header if (Webchat::Login::GetVerificationAdmin($Database, $cgi, \%param)) { print $cgi->p( $cgi->h1('Webchat Tag Administration')); print $cgi->start_form(); # Start form DataHandlerAll($cgi, \%param); print $cgi->p($cgi->submit(), $cgi->reset()), "\n"; Webchat::Param::EmbedNormal($Database, $cgi, \%param); print $cgi->end_form(), "\n"; } print $cgi->end_html; # End HTML $Database->disconnect(); # Disconnect database ################################################################################# # Sub-Routines ################################################################################# ##################### # DataHandler # # Takes in a CGI handle and the name of the hash to activate and displays # information within those hashes. If changes, will make the change neccesary. sub DataHandler # CGI, Number for hash { ##################### # Data members my $cgi = shift; # Cgi filehandle my $param = shift; # Hash of parameters my $choice = shift; # Choice of hash to open my $dbm; # DBM being used my $key; # Arbitrary key my $value; # Arbitrary value my %hash; # Arbitrary hash ##################### # Program area # Determine appropriate dbm to open and assign value to dbm scalar if ($choice == 0) # MySQL { Webchat::Dbm::DBMOpenMySQL(\%hash); $dbm = 'MySQL'; } elsif ($choice == 1) # Realm { Webchat::Dbm::DBMOpenRealm(\%hash); $dbm = 'Realm'; } elsif ($choice == 2) # Portal { Webchat::Dbm::DBMOpenPortal(\%hash); $dbm = 'Portal'; } elsif ($choice == 3) # Login { Webchat::Dbm::DBMOpenLogin(\%hash); $dbm = 'Login'; } elsif ($choice == 4) # Configuration { Webchat::Dbm::DBMOpenConfiguration(\%hash); $dbm = 'Configuration'; } elsif ($choice == 5) # Chat { Webchat::Dbm::DBMOpenChat(\%hash); $dbm = 'Chat'; } elsif ($choice == 6) # System { Webchat::Dbm::DBMOpenSystem(\%hash); $dbm = 'System'; } elsif ($choice == 99) # All dbms { # Call each data hander seperately DataHandler($cgi, $param, 0); DataHandler($cgi, $param, 1); DataHandler($cgi, $param, 2); DataHandler($cgi, $param, 3); DataHandler($cgi, $param, 4); DataHandler($cgi, $param, 5); DataHandler($cgi, $param, 6); } # Only complete following if under 99 if ($choice < 99) { DisplayHandlerHeading($cgi, $dbm); DisplayHandlerTop($cgi, $dbm); DisplayHandlerTitle($cgi, $dbm); # Loop through and display information foreach $choice (sort keys %hash) { # If diffrent change if ((defined($param->{"$dbm$choice"})) && ($param->{"$dbm$choice"} ne $hash{$choice})) { # Assign value and display $hash{$choice} = $param->{"$dbm$choice"}; DisplayHandlerNewInfo($cgi, $dbm, $choice, 'yes', $hash{$choice}); } # Else display as no one really cares else { DisplayHandlerInfo($cgi, $dbm, $choice, 'no', $hash{$choice}); } } DisplayHandlerBottom($cgi, $dbm); # Unlink hash from dbm Webchat::Dbm::DBMClose(\%hash); } } # Alias for MySQL sub DataHandlerMySQL { DataHandler(shift, shift, 0); } # Alias for Realm sub DataHandlerRealm { DataHandler(shift, shift, 1); } # Alias for Portal sub DataHandlerPortal { DataHandler(shift, shift, 2); } # Alias for Login sub DataHandlerLogin { DataHandler(shift, shift, 3); } # Alias for Configuration sub DataHandlerConfiguration { DataHandler(shift, shift, 4); } # Alias for Chat sub DataHandlerChat { DataHandler(shift, shift, 5); } # Alias for System sub DataHandlerSystem { DataHandler(shift, shift, 6); } # Alias for all sub DataHandlerAll { DataHandler(shift, shift, 99); } ##################### # DisplayHandler # # Make formatted tables based on information received and options. sub DisplayHandler { ##################### # Data members my $cgi = shift; # Cgi filehandle my $choice = shift; # Choice of hash to open my $dbm = shift; # DBM being worked on my @title = qw(Key Change Value); # Titles ##################### # Program area # Top of Table if ($choice == 0) # Table top { print "\n"; } # Title section of table elsif ($choice == 1) # Table title { print "\t\n"; # Row beginning # Print first three title columns print "\t\t\n"; print "\t\t\n"; print "\t\t\n"; print "\t\n"; # Row end } # Information row of table elsif ($choice == 2) # Table data { print "\t\n"; # Row beginning # Print three columns of data print "\t\t\n"; print "\t\t\n"; print "\t\t\n"; print "\t\n"; # Row end } # Information row of table elsif ($choice == 3) # Table data { print "\t\n"; # Row beginning # Print three columns of data print "\t\t\n"; print "\t\t\n"; print "\t\t\n"; print "\t\n"; # Row end } # Bottom of table elsif ($choice == 4) # Table bottom { print "
$title[0]$title[1]$title[2]
$_[0]$_[1]", $cgi->textfield("$dbm$_[0]",$_[2],80,180), "
$_[0]$_[1]", $cgi->textfield("$dbm$_[0]",$_[2],80,180), "
\n"; } # Heading of table elsif ($choice == 5) # Table bottom { print "
\n
\n$dbm\n
\n"; } } # Alias table top sub DisplayHandlerTop { DisplayHandler(shift, 0, shift); } # Alias table bottom sub DisplayHandlerBottom { DisplayHandler(shift, 4, shift); } # Alias table title sub DisplayHandlerTitle { DisplayHandler(shift, 1, shift); } # Alias table info sub DisplayHandlerInfo { DisplayHandler(shift, 2, shift, @_); } # Alias table new info sub DisplayHandlerNewInfo { DisplayHandler(shift, 3, shift, @_); } # Alias table heading sub DisplayHandlerHeading { DisplayHandler(shift, 5, shift); } ethereal-1.0.0/admin/dbsetup.plx100755 0 0 52524 7053646664 14716 0ustar rootroot#!/bin/perl -w ################################################################################# # Created : Martin Foster # Modified : 02/19/2000 ################################################################################# # # Database Setup - Script part of Webchat designed to configure MySQL for use # Copyright (C) 2000 Martin Foster # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # # Author of this script can be contacted at the following: # E-Mail : mfoster@redwhite.com # Address : Suite 209 - 355 5th Ave NE # Calgary, Alberta # T2R 0K9 # ################################################################################# use Cwd; # Current working directory use DBI; # Database independent layer use String::Random; # Random string generator ################################################################################# # Data Members ################################################################################# ##################### # Database Limits # PUPPETEER $PuppeteerLogin = 10; # Login name $PuppeteerPassword = CryptLenght('SALT', 'Secret'); # Password $PupeteerName = 30; # Full name $PuppeteerEMail = 45; # E-Mail address # PUPPET $PuppetName = 30; # Handle Name $PuppetPic = 200; # Picture link address $PuppetTextColour = 8; # Text colour used by character # REALM $RealmName = 30; # Name of realm # POST $PostTo = 30; # Puppet receiving # WORD_RESTRICTION $WordSpelling = 10; # Word Spelling # PUPPETEER_REGISTRATION $PuppeteerConfCode = 10; # Confirmation code # WEBCHAT_TEXT $WebchatTextName = 20; # Identifying name ##################### # Database Indentifier $dbserver = 'localhost'; # Server name $dbdatam = 'mysql'; # MySQL database $dbdataw = 'webchat'; # Webchat database $dbuserm = 'root'; # Username mysql $dbpassm = ''; # Password mysql $dbuserw = 'webchat'; # Username webchat $dbpassw = ''; # Password webchat $dbport = 3306; # Port (Default 3306) $dbemail = 'root@localhost'; # E-Mail address for superuser ##################### # Document Locations $prefix = getcwd(); # Prefix directory $docaup = "$prefix/docs/aup.txt"; # Acceptable use policy $docinvi = "$prefix/docs/invitation.txt"; # Invatation when joining $dochead = "$prefix/docs/header.txt"; # Default header $docfoot = "$prefix/docs/footer.txt"; # Default footer $docside = "$prefix/docs/sidebar.txt"; # Default sidebar $docrealm = "$prefix/docs/realminfo.txt"; # Default realm-info $docbio = "$prefix/docs/bio.txt"; # Default user bio $docregist = "$prefix/docs/register.txt"; # Registration text $docjava = "$prefix/docs/javascript.txt"; # Javascript text $docconnect = "$prefix/docs/connect.txt"; # Connection failure to realm notice ##################### # General my $Database; # Database handle ################################################################################# # Program Area ################################################################################# VarDisplay(); # Display environment variables $Database = DataConnectMysql(); # Connect to MySQL # Functions related directly to MySQL database print "\n\nDATABASE SPECIFICS\n"; unless (DataVerifyUser($Database)) # Check for webchat user { DataCreateUser($Database); } unless (DataVerifyDataAccess($Database)) # Data access to database { DataCreateDataAccess($Database); } unless (DataVerifyDatabase($Database)) # Check if database exits { DataCreateDatabase($Database); } $Database->disconnect; $Database = DataConnectWebchat(); # Connect to webchat # Functions related directly to webchat print "\n\nEXISTENCE OF TABLES\n"; DataCreateTables($Database); # Create all tables if needed print "\n\nCREATING SUPERUSER\n"; unless (DataVerifySuperuser($Database)) # Create superuser account { DataCreateSuperuser($Database); } print "\n\nCREATING DEFAULT DOCUMENTS\n"; DocumentInsertAll($Database); $Database->disconnect; ################################################################################# # Sub-Routines ################################################################################# ##################### # CryptLenght # # Subroutine designed to discover the lenght of crypted text handed to it. # This is primarily to increase protability since some Perl distributions # do not use the classic UNIX salted passwords of ten characters. sub CryptLenght # Salt, Word { ##################### # Data Members my $salt = shift; # Salt used my $word = shift; # Word applied ##################### # Program Area $_ = crypt($word, $salt); # Crypt password return tr/A-Za-z0-9.$\///; # Return lenght of crypt } ##################### # DataConnect # # Subroutine designed to hide the code for database connection. sub DataConnect # MySQL or Webchat Datasource { ##################### # Data Members my $action = shift; # Action to take my $Database; # Database handle ##################### # Program Area # Connect to MySQL if ($action != 1) { $Database = DBI->connect("DBI:mysql:$dbdatam:$dbserver:$dbport", $dbuserm, $dbpassm, {PrintError => 1}) || die ("Database Error \#$DBI::err : $DBI::errstr"); } # Connect to Webchat else { $Database = DBI->connect("DBI:mysql:$dbdataw:$dbserver:$dbport", $dbuserm, $dbpassm, {PrintError => 1}) || die ("MySQL Error \#$DBI::err : $DBI::errstr"); } return $Database; } # Alias for MySQL sub DataConnectMysql { return DataConnect(0); } # Alias for Webchat sub DataConnectWebchat { return DataConnect(1); } ##################### # DataCreate # # Creates needed fields, based on SQL received sub DataCreate { ##################### # Data members my $Database = shift; # Database handle my $sql = shift; # SQL syntax ##################### # Program Area $Database->do($sql); # Create handle } # User creation alias sub DataCreateUser { # Print creation message print "\t........................................$dbuserw CREATED\n"; DataCreate(shift, "INSERT INTO user (host, user, password) VALUES('$dbserver', '$dbuserw', password('$dbpassw'))"); } # Data creation alias sub DataCreateDataAccess { # Print creation message print "\t........................................Data Access CREATED\n"; DataCreate(shift, "INSERT INTO db VALUES('$dbserver', '$dbdataw', '$dbuserw', 'Y', 'Y', 'Y', 'Y', 'N', 'N', 'N', 'N', 'N', 'N')"); } # Database creation alias sub DataCreateDatabase { # Print creation message print "\t........................................$dbdataw CREATED\n"; DataCreate(shift, "CREATE DATABASE $dbdataw"); } ##################### # DataCreateTables # # Rather long sub-routine that carries with it all the needed information needed # to create all tables in the Webchat database. sub DataCreateTables { ##################### # Data members my $Database = shift; # Database handle my @tables = qw(Puppeteer Puppet Realm RealmSupervisor Post PuppeteerRestriction PuppetInvitation PuppeteerRegistration WordRestriction WebchatText PuppetIgnore Audit); my $table; ##################### # Program area # Run through list of tables foreach $table (@tables) { # Verify is non existent create unless (DataVerifyTables($Database, $table)) { # Print creation message print "\t........................................$table CREATED\n"; # Puppeteer # # Primary login for all of associated puppets. Contains basic # information about Puppeteer as to make contact if needed. # Also contrains preferences and rights. if ($table eq 'Puppeteer') { $Database->do("CREATE TABLE Puppeteer ( PuppeteerLogin VARCHAR($PuppeteerLogin) PRIMARY KEY, PuppeteerPassword CHAR($PuppeteerPassword) NOT NULL, PuppeteerName VARCHAR($PupeteerName) NOT NULL, PuppeteerEMail VARCHAR($PuppeteerEMail) NOT NULL, PuppeteerTimestamp INT, PuppeteerFormatting ENUM('complete','imageless','spartan') NOT NULL DEFAULT 'complete', PuppeteerChatPref ENUM('basic','framed','stream') NOT NULL DEFAULT 'basic', PuppeteerJavascript ENUM('yes','no') NOT NULL DEFAULT 'yes', PuppeteerAdminPrivs ENUM('yes','no') DEFAULT 'no', PuppeteerSuperPrivs ENUM('yes','no') DEFAULT 'no' )"); } # Puppet # # Identities by which the puppeteer is known. Each can have a # unique set of attributes for which to be used. elsif ($table eq 'Puppet') { $Database->do("CREATE TABLE Puppet ( PuppetName VARCHAR($PuppetName) PRIMARY KEY, PuppeteerLogin VARCHAR($PuppeteerLogin) NOT NULL, PuppetTag BLOB, PuppetPic VARCHAR($PuppetPic), PuppetPicHeight SMALLINT, PuppetPicWidth SMALLINT, PuppetTitle BLOB, PuppetBio BLOB, PuppetTextColour VARCHAR($PuppetTextColour) DEFAULT 'black', PuppetTextSize TINYINT DEFAULT '0' )"); } # Realm # # Can be consider worlds in which a puppet can be played in # All realms have a level of customization except for Private # Realsm which adhere to defaults. elsif ($table eq 'Realm') { $Database->do("CREATE TABLE Realm ( RealmName VARCHAR($RealmName) PRIMARY KEY, RealmLanguage ENUM('relaxed','restricted') NOT NULL DEFAULT 'relaxed', RealmAccess ENUM('relaxed','restricted','list') NOT NULL DEFAULT 'relaxed', RealmGuests ENUM('yes','no','post') NOT NULL DEFAULT 'yes', RealmPublic ENUM('yes','no') NOT NULL DEFAULT 'yes', RealmTags ENUM('relaxed','restricted') NOT NULL DEFAULT 'relaxed', RealmInfo BLOB, RealmSidebar BLOB, RealmHeader BLOB, RealmFooter BLOB, RealmImageHeight SMALLINT DEFAULT '0', RealmImageWidth SMALLINT DEFAULT '0', RealmTimestamp INT )"); } # Realm Supervisor # # Realm supervisors have creative control over the Realm such # as colour and HTML as well as control over access. elsif ($table eq 'RealmSupervisor') { $Database->do("CREATE TABLE RealmSupervisor ( RealmName VARCHAR($RealmName) NOT NULL, PuppeteerLogin VARCHAR($PuppeteerLogin) NOT NULL, UNIQUE PKRealmSupervisor (RealmName, PuppeteerLogin) )"); } # Post # # A post is a message composed by a puppeteer from a puppet and # sent to other puppets within a Realm. They do not migrate. elsif ($table eq 'Post') { $Database->do("CREATE TABLE Post ( PostIDNumber INTEGER AUTO_INCREMENT PRIMARY KEY, RealmName VARCHAR($RealmName) NOT NULL, PuppetName VARCHAR($PuppetName) NOT NULL, PostTo VARCHAR($PuppetName) NOT NULL, PostTimestamp INT, PostFullFormat BLOB, PostImagelessFormat BLOB, PostPartialFormat BLOB )"); } # Word Resriction # # Optional in realms but allows a supervisor to restrict certain # words used in the Realm itself. Normally swears. elsif ($table eq 'WordRestriction') { $Database->do("CREATE TABLE WordRestriction ( WordSpelling VARCHAR($WordSpelling) NOT NULL, RealmName VARCHAR($RealmName) NOT NULL, UNIQUE PKWordRestriction (WordSpelling, RealmName) )"); } # Puppeteer Restirctions # # This will prevents a puppeteers from entering a realm. This # is not permenant and will be revoked at a certain time. For # lenght decided by admin. elsif ($table eq 'PuppeteerRestriction') { $Database->do("CREATE TABLE PuppeteerRestriction ( PuppeteerLogin VARCHAR($PuppeteerLogin) NOT NULL, RealmName VARCHAR($RealmName) NOT NULL, RestrictionTimestamp INT NOT NULL, UNIQUE PKPuppeteerRestriction (PuppeteerLogin, RealmName) )"); } # Puppet Invitation # # Similiar to puppeteer restriction, except that it restricts who # can enter. In this case puppets for tighter control. elsif ($table eq 'PuppetInvitation') { $Database->do("CREATE TABLE PuppetInvitation ( PuppetName VARCHAR($PuppetName) NOT NULL, RealmName VARCHAR($RealmName) NOT NULL, UNIQUE PKPuppetInvitation (PuppetName, RealmName) )"); } # Puppet Ignore # # Applied if a puppeteer wishes to no longer receive posts by # a certain puppet. elsif ($table eq 'PuppetIgnore') { $Database->do("CREATE TABLE PuppetIgnore ( PuppeteerLogin VARCHAR($PuppeteerLogin) NOT NULL, PuppetName VARCHAR($PuppetName) NOT NULL, UNIQUE PKPuppetIgnore (PuppeteerLogin, PuppetName) )"); } # Puppeteer Registration # # Denormorlized due to it's lack of use compared to the # normal fields. Used in registration, failure to # register results in puppeteer being removed. elsif ($table eq 'PuppeteerRegistration') { $Database->do("CREATE TABLE PuppeteerRegistration ( PuppeteerLogin VARCHAR($PuppeteerLogin) PRIMARY KEY, PuppeteerConfCode VARCHAR($PuppeteerConfCode) NOT NULL, PuppeteerTimeStamp INT NOT NULL )"); } # Webcat Texts # # Contains various documents used in WebChat. elsif ($table eq 'WebchatText') { $Database->do("CREATE TABLE WebchatText ( WebchatTextName VARCHAR($WebchatTextName) PRIMARY KEY, WebchatTextContent BLOB )"); } # Audit # # Auditing table for supervisor actions elsif ($table eq 'Audit') { $Database->do("CREATE TABLE Audit ( AuditNumber INT NOT NULL AUTO_INCREMENT, PuppeteerLogin VARCHAR($PuppeteerLogin) NOT NULL, AuditAction VARCHAR(200), AuditTimestamp DATETIME, UNIQUE PKAudit (AuditNumber, PuppeteerLogin) )"); } } } } ##################### # Superuser Create # # Creates the first adminstrator of the webchat scripts. Will actually use the # The existing username and password my MySQL. Username will remain the same # password will be of course changeable. sub DataCreateSuperuser { ##################### # Data Members my $Database = shift; # Database handle my $salt; # Encryption salt my $crypt; # Crypted password my $String = new String::Random; ##################### # Program Area $salt = $String->randpattern("ssssssss"); # Create random salt $crypt = crypt($dbpassm, $salt); # Encrypt password print "\t........................................Superuser CREATED\n"; # Insert into database superuser, with defaults and full supervisory rights $Database->do("INSERT INTO Puppeteer VALUES(?, ?, ?, ?, NULL, 'complete','basic', 'yes', 'yes', 'yes')", {}, $dbuserm, $crypt, $dbuserm, $dbemail); } ##################### # DataVerify # # Used to verify existence of certain information based on received SQL statement # and the word to check. sub DataVerify # Database, SQL statement, keyword { ##################### # Data members my $Database = shift; # Database handle my $Statement; # SQL statement my $sql = shift; # SQL syntax my $keyword = shift; # Search word ##################### # Program Area # Prepare SQL $Statement = $Database->prepare($sql); $Statement->execute(); print "\n\tSearching for $keyword:\n"; # Run through list while ($_ = $Statement->fetchrow()) { # Search for keyword if ($_ eq $keyword) { # Close statement and return true print "\t........................................FOUND\n"; $Statement->finish(); return 1; } } # Close statement and return false print "\t........................................NOT FOUND\n"; $Statement->finish(); return 0; } # Alias user field sub DataVerifyUser { return DataVerify(shift, "SELECT distinct(user) FROM user WHERE user='$dbuserw'", $dbuserw); } # Alias for database access sub DataVerifyDataAccess { return DataVerify(shift, "SELECT distinct(user) FROM db WHERE user='$dbuserw' AND db='$dbdataw'", $dbuserw); } # Alias for document existence sub DataVerifyDocument { return DataVerify(shift, "SELECT WebchatTextName FROM WebchatText", shift); } # Alias for superuser find sub DataVerifySuperuser { return DataVerify(shift, "SELECT PuppeteerLogin FROM Puppeteer WHERE PuppeteerLogin='$dbuserm'", $dbuserm); } # Alias for databases sub DataVerifyDatabase { return DataVerify(shift, 'SHOW DATABASES', $dbdataw); } # Alias for tables sub DataVerifyTables { return DataVerify(shift, 'SHOW TABLES', shift); } ##################### # Document Insert # # This sub-routine is blessed with the responsibility of being used for # the very useful task of taking in text files, writing them to a scalar # and taking that sclar moving it into a row into the Webchat database. sub DocumentInsert # Database handle, Filename, Row { ##################### # Data members my $Database = shift; # Database handle my $filename = shift; # Filename my $rowname = shift; # Name of row to find my $line; # Single line my $field; # Field of data ##################### # Program area # Check for existence first unless (DataVerifyDocument($Database, $rowname)) { # Verify file access if ((-f $filename) && (-R $filename)) { # Create and open filehandle open(FILE, $filename) or Die("Unable to open $filename: $!"); print "\t........................................$filename READING\n"; # Read file and retreive lines while ($line = ) { # Insert lines into field as needed # As to remove errors if (defined($field)) { $field = "$field$line"; } # As to remove errors else { $field = $line; } } # Insert into database $Database->do("INSERT INTO WebchatText VALUES(?,?)", {}, $rowname, $field); close(FILE); # Close filehandle # Print pwetty message print "\t........................................$rowname CREATED\n"; } else { print "\t........................................$filename NOT FOUND\n"; }; } } # Alias for Accepteable Use Policy sub DocumentInsertAUP { DocumentInsert(shift, $docaup, 'AcceptableUsePolicy'); } # Alias for Invitation sub DocumentInsertInvitation { DocumentInsert(shift, $docinvi, 'Invitation'); } # Alias for HTML Header sub DocumentInsertHeader { DocumentInsert(shift, $dochead, 'WebHeader'); } # Alias for HTML Footer sub DocumentInsertFooter { DocumentInsert(shift, $docfoot, 'WebFooter'); } # Alias for Sidebar sub DocumentInsertSidebar { DocumentInsert(shift, $docside, 'WebSidebar'); } # Alias for Realm Information sub DocumentInsertRealm { DocumentInsert(shift, $docrealm, 'InfoRealm'); } # Alias for Puppet Bio sub DocumentInsertBio { DocumentInsert(shift, $docbio, 'InfoBio'); } # Alias for Registration sub DocumentInsertRegistration { DocumentInsert(shift, $docregist, 'Registration'); } # Alias for Accepted registrations sub DocumentInsertAccepted { DocumentInsert(shift, $docaccept, 'Accepted'); } # Alias for Connect failure sub DocumentInsertConnect { DocumentInsert(shift, $docconnect, 'WebConnect'); } # Alias for Javascript text sub DocumentInsertJavascript { DocumentInsert(shift, $docjava, 'WebJavascript'); } # Alias for all texts sub DocumentInsertAll { # Access all documents DocumentInsertAUP($_[0]); DocumentInsertInvitation($_[0]); DocumentInsertHeader($_[0]); DocumentInsertFooter($_[0]); DocumentInsertSidebar($_[0]); DocumentInsertRealm($_[0]); DocumentInsertBio($_[0]); DocumentInsertRegistration($_[0]); DocumentInsertAccepted($_[0]); DocumentInsertConnect($_[0]); DocumentInsertJavascript($_[0]); } ##################### # VarDisplay # # Simple function to display variables are run-time for script Display are: # - Field sizes in tables # - MySQL connection information # - Document locations sub VarDisplay { ##################### # Program Area print "FIELD SIZES (See schema for more information)\n"; print "\tPuppeteerLogin : $PuppeteerLogin\n"; print "\tPuppeteerPassword : $PuppeteerPassword\n"; print "\tPupeteername : $PupeteerName\n"; print "\tPuppeteerEMail : $PuppeteerEMail\n"; print "\tPuppetName : $PuppetName\n"; print "\tPuppetPic : $PuppetPic\n"; print "\tPuppetTextColour : $PuppetTextColour\n"; print "\tRealmName : $RealmName\n"; print "\tPostTo : $PostTo\n"; print "\tPuppeteerConfCode : $PuppeteerConfCode\n"; print "\tWebchatTextName : $WebchatTextName\n\n"; print "MYSQL SETTINGS\n"; print "\tMySQL server name : $dbserver\n"; print "\tMySQL database : $dbdatam\n"; print "\tWebchat database : $dbdataw\n"; print "\tMySQL username : $dbuserm\n"; print "\tMySQL password : $dbpassm\n"; print "\tWebchat username : $dbuserw\n"; print "\tWebchat password : $dbpassw\n"; print "\tMySQL port number : $dbport\n\n"; print "\tSuperuser E-Mail : $dbemail\n\n"; print "DOCUMENT LOCATIONS\n"; print "\tCurrent directory : $prefix\n"; print "\tAcceptable use : $docaup\n"; print "\tInvitation : $docinvi\n"; print "\tDefault header : $dochead\n"; print "\tDefault footer : $docfoot\n"; print "\tDefault sidebar : $docside\n"; print "\tDefault realminfo : $docrealm\n"; print "\tDefault user BIO : $docbio\n"; } ethereal-1.0.0/admin/docs/ 40755 0 0 0 7053646576 13325 5ustar rootrootethereal-1.0.0/admin/docs/connect.txt100644 0 0 134 7053646576 15572 0ustar rootroot

REALM CONNECTION FAILURE NOTICE HERE

ethereal-1.0.0/admin/docs/invitation.txt100644 0 0 271 7053646576 16327 0ustar rootrootWelcome FULLNAME to SERVERNAME This is beyond a draft copy: Send this in subject field - click on the following link AUTHSTRING Otherwise logins will not be allowed... RETURNEMAIL ethereal-1.0.0/admin/docs/realminfo.txt100644 0 0 112 7053646576 16111 0ustar rootroot

THIS SPACE FOR RENT

ethereal-1.0.0/admin/docs/bio.txt100644 0 0 112 7053646576 14706 0ustar rootroot

THIS SPACE FOR RENT

ethereal-1.0.0/admin/docs/aup.txt100644 0 0 121 7053646576 14722 0ustar rootroot

ACCEPTABLE USE POLICY HERE

ethereal-1.0.0/admin/docs/header.txt100644 0 0 1116 7053646576 15412 0ustar rootroot Secure Mailer ethereal-1.0.0/admin/docs/sidebar.txt100644 0 0 1251 7053646576 15573 0ustar rootroot Secure Mailer

THIS SPACE FOR RENT

ethereal-1.0.0/admin/docs/accepted.txt100644 0 0 104 7053646576 15706 0ustar rootroot

ACCEPTED HERE

ethereal-1.0.0/admin/docs/javascript.txt100644 0 0 1156 7053646576 16334 0ustar rootroot ethereal-1.0.0/admin/docs/footer.txt100644 0 0 1021 7053646576 15453 0ustar rootroot

This project is undergoing heavy development and thus no guarantees can be made as to the security behind the system.; Bug submissions can be made to webmaster@andrastea.dynodns.net, This does not include periods of outages, sever based errors that happen infrequently, as this would probably be an indication that work is currently being done conducted on the system and design.

ethereal-1.0.0/admin/docs/register.txt100644 0 0 121 7053646576 15761 0ustar rootroot

REGISTER INSTRUCTIONS HERE

ethereal-1.0.0/portal.plx100755 0 0 21240 7053646576 13452 0ustar rootroot#!/bin/perl ################################################################################# # Created : Martin Foster # Modified : 01/17/2000 ################################################################################# # # Portal - Script part of Webchat designed to authenthicate and and lead to realms # Copyright (C) 2000 Martin Foster # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # # Author of this script can be contacted at the following: # E-Mail : mfoster@redwhite.com # Address : Suite 209 - 355 5th Ave NE # Calgary, Alberta # T2R 0K9 # ################################################################################# use CGI qw(:standard); # Common gateway interface use CGI::Carp qw(fatalsToBrowser); # CGI Error logs use strict; # Strict variable enforcement use Webchat::Database; # Database handler use Webchat::Dbm; # DBM Addition use Webchat::Login; # Login functionality use Webchat::Param; # Parameter control use Webchat::Who; # Who is on ################################################################################# # Data Members ################################################################################# my $Database; # Database handle my $cgi; # Common gateway interface handle my %param; # Parameter hash ################################################################################# # Program Area ################################################################################# $cgi = new CGI; # Create CGI Handle Webchat::Database::DatabaseConnect(\$Database); # Connect to MySQL Webchat::Param::GetParam($cgi, \%param); # Retreive parameters print $cgi->header(); # File header Webchat::Database::DocumentGetHeader($Database); # HTML header if ( Webchat::Login::GetVerificationNormal($Database, $cgi, \%param) ) { # If undefined list realms, puppets and links unless (defined($param{'THIRDCHAPTER'})) { SecondChapter($Database, $cgi, \%param); } # Otherwise open gateway elsif (defined($param{'THIRDCHAPTER'})) { ThirdChapter($Database, $cgi, \%param); } } Webchat::Database::DocumentGetFooter($Database); # HTML footer $Database->disconnect(); # Disconnect database handle ################################################################################# # Sub-Routines ################################################################################# ##################### # Second Chapter # # Unusual name given to a part of the script that will be exected once the user # has been authenthicated. sub SecondChapter # Database, CGI, Parameter list { ##################### # Data members my $Database = shift; # Database handle my $Statement; # SQL Statement my $cgi = shift; # CGI handle my $param = shift; # Parameter list my $inline; # Inline embeding of data my $javascript; # Javascript control my $realms; # Formatted list of realms my $puppets; # Formatted list of puppets my @realms; # List of realms my @puppets; # List of puppets my %portal; # Portal hash ##################### # Program area # Link DBM to hash Webchat::Dbm::DBMOpenPortal(\%portal); # Javascript Options # Retreive Javascript choice ($javascript) = Webchat::Database::DataGetJavascript($Database, Webchat::Login::Unmangle($param->{'USER'})); # Possibly display Javascript if ($javascript eq 'yes') { Webchat::Database::DocumentGetJavascript($Database); } # Retreive and format values for Realms and Puppets Webchat::Database::GetListPublicRealms($Database, \@realms); Webchat::Database::GetListPuppetYours($Database, \@puppets, Webchat::Login::Unmangle($param->{'USER'})); $realms = $cgi->scrolling_list('ROOM', \@realms, $realms[0], 5); $puppets = $cgi->scrolling_list('CHAR', \@puppets, $puppets[0], 5); # Display title print "$portal{'TagTitle'}\n
\n"; # Realm Section print $cgi->start_form(); Webchat::Table::MakeTop($cgi); Webchat::Table::MakeSingle($cgi, $portal{'TagSecRealm'}); Webchat::Table::MakeValid($cgi, $portal{'TagSelectPuppet'}, $puppets); Webchat::Table::MakeBlank($cgi); Webchat::Table::MakeValid($cgi, $portal{'TagSelectRealm'}, $realms); Webchat::Table::MakeBlank($cgi); Webchat::Table::MakeValid($cgi, $portal{'TagSelectPrivate'}, $cgi->textfield('ALTROOM', '', 20, 30)); Webchat::Table::MakeBlank($cgi); Webchat::Table::MakeValid($cgi, $cgi->submit($portal{'TxtSubmitRealms'}), $cgi->reset($portal{'TxtResetRealms'})); Webchat::Table::MakeBottom($cgi); Webchat::Param::EmbedNormal($Database, $cgi, $param); # Embed for third chapter print $cgi->hidden('THIRDCHAPTER', 'quiaff'); # Embed for third chapter print $cgi->end_form(), "\n"; print "
\n
\n"; # Spacer # Create inline link $inline = Webchat::Param::EmbedInline($Database, $cgi, $param); # Determin supervisory rights # Prepare and execute $Statement = $Database->prepare("SELECT PuppeteerSuperPrivs FROM Puppeteer WHERE PuppeteerLogin=?"); $Statement->execute(Webchat::Login::Unmangle($param->{'USER'})); # Capture and finish my $choice = $Statement->fetchrow(); $Statement->finish(); Webchat::Table::MakeTop($cgi); Webchat::Table::MakeSingle($cgi, $portal{'TagSecPuppeteer'}); Webchat::Table::MakeBlank($cgi); # Link handling if ($javascript eq 'no') { # Non javascript links Webchat::Table::MakeSingle($cgi, "$portal{'TagLnkPuppeteer'}"); Webchat::Table::MakeSingle($cgi, "$portal{'TagLnkPuppet'}"); Webchat::Table::MakeSingle($cgi, "$portal{'TagLnkIgnore'}"); # Display following button if supervisor if ($choice eq 'yes') { Webchat::Table::MakeSingle($cgi, "$portal{'TagLnkSupervisor'}"); } } else { # Javascript links Webchat::Table::MakeSingle($cgi, "$portal{'TagLnkPuppeteer'}"); Webchat::Table::MakeSingle($cgi, "$portal{'TagLnkPuppet'}"); Webchat::Table::MakeSingle($cgi, "$portal{'TagLnkIgnore'}"); # Display following button if supervisor if ($choice eq 'yes') { Webchat::Table::MakeSingle($cgi, "$portal{'TagLnkSupervisor'}"); } } Webchat::Table::MakeBottom($cgi); # Unlink DBM to hash Webchat::Dbm::DBMClose(\%portal); } ##################### # Third Chapter # # Unusual name given to a part of the script that will be exected once the user # in his infinit wisdom has selected a puppet and realm sub ThirdChapter # Database, CGI, Parameter list { ##################### # Data members my $Database = shift; # Database handle my $cgi = shift; # CGI handle my $param = shift; # Parameter list my $choice; # To be or not to be my $room; # Room name my $info; # Room information ##################### # Program area # Determine need to create a room if (($param->{'ALTROOM'} =~ tr/a-zA-Z0-9//) > 4) { # Unmangle and use $room = Webchat::Login::Unmangle($param->{'ALTROOM'}); # Retreive query information ($choice) = Webchat::Database::DataGetRealmExistence($Database, $room); # Create if not found unless (defined($choice)) { $Database->do("INSERT INTO Realm VALUES(?, 'relaxed', 'relaxed', 'yes', 'no', 'relaxed', NULL, NULL, NULL, NULL, '0', '0', ?)", {}, $room, time); } # Assign one to the other (As to be called properly) $param->{'ROOM'} = $param->{'ALTROOM'}; } # Call and display entrance Webchat::Who::WhoEntrance($Database, $cgi, $param); # Retreive realm information ($info) = Webchat::Database::DataGetRealmDescription($Database, Webchat::Login::Unmangle($param->{'ROOM'})); # Display realm information if (defined($info)) { print "$info\n"; } } ethereal-1.0.0/license.txt100644 0 0 23546 7053646576 13617 0ustar rootroot GNU GENERAL PUBLIC LICENSE Version 2, June 1991 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Everyone is permitted to copy and distribute verbatim copies of this license document, but changing it is not allowed. Preamble The licenses for most software are designed to take away your freedom to share and change it. By contrast, the GNU General Public License is intended to guarantee your freedom to share and change free software--to make sure the software is free for all its users. This General Public License applies to most of the Free Software Foundation's software and to any other program whose authors commit to using it. (Some other Free Software Foundation software is covered by the GNU Library General Public License instead.) You can apply it to your programs, too. When we speak of free software, we are referring to freedom, not price. Our General Public Licenses are designed to make sure that you have the freedom to distribute copies of free software (and charge for this service if you wish), that you receive source code or can get it if you want it, that you can change the software or use pieces of it in new free programs; and that you know you can do these things. To protect your rights, we need to make restrictions that forbid anyone to deny you these rights or to ask you to surrender the rights. These restrictions translate to certain responsibilities for you if you distribute copies of the software, or if you modify it. For example, if you distribute copies of such a program, whether gratis or for a fee, you must give the recipients all the rights that you have. You must make sure that they, too, receive or can get the source code. And you must show them these terms so they know their rights. We protect your rights with two steps: (1) copyright the software, and (2) offer you this license which gives you legal permission to copy, distribute and/or modify the software. Also, for each author's protection and ours, we want to make certain that everyone understands that there is no warranty for this free software. If the software is modified by someone else and passed on, we want its recipients to know that what they have is not the original, so that any problems introduced by others will not reflect on the original authors' reputations. Finally, any free program is threatened constantly by software patents. We wish to avoid the danger that redistributors of a free program will individually obtain patent licenses, in effect making the program proprietary. To prevent this, we have made it clear that any patent must be licensed for everyone's free use or not licensed at all. The precise terms and conditions for copying, distribution and modification follow. GNU GENERAL PUBLIC LICENSE TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION 0. This License applies to any program or other work which contains a notice placed by the copyright holder saying it may be distributed under the terms of this General Public License. The "Program", below, refers to any such program or work, and a "work based on the Program" means either the Program or any derivative work under copyright law: that is to say, a work containing the Program or a portion of it, either verbatim or with modifications and/or translated into another language. (Hereinafter, translation is included without limitation in the term "modification".) Each licensee is addressed as "you". Activities other than copying, distribution and modification are not covered by this License; they are outside its scope. The act of running the Program is not restricted, and the output from the Program is covered only if its contents constitute a work based on the Program (independent of having been made by running the Program). Whether that is true depends on what the Program does. 1. You may copy and distribute verbatim copies of the Program's source code as you receive it, in any medium, provided that you conspicuously and appropriately publish on each copy an appropriate copyright notice and disclaimer of warranty; keep intact all the notices that refer to this License and to the absence of any warranty; and give any other recipients of the Program a copy of this License along with the Program. You may charge a fee for the physical act of transferring a copy, and you may at your option offer warranty protection in exchange for a fee. 2. You may modify your copy or copies of the Program or any portion of it, thus forming a work based on the Program, and copy and distribute such modifications or work under the terms of Section 1 above, provided that you also meet all of these conditions: a) You must cause the modified files to carry prominent notices stating that you changed the files and the date of any change. b) You must cause any work that you distribute or publish, that in whole or in part contains or is derived from the Program or any part thereof, to be licensed as a whole at no charge to all third parties under the terms of this License. c) If the modified program normally reads commands interactively when run, you must cause it, when started running for such interactive use in the most ordinary way, to print or display an announcement including an appropriate copyright notice and a notice that there is no warranty (or else, saying that you provide a warranty) and that users may redistribute the program under these conditions, and telling the user how to view a copy of this License. (Exception: if the Program itself is interactive but does not normally print such an announcement, your work based on the Program is not required to print an announcement.) These requirements apply to the modified work as a whole. If identifiable sections of that work are not derived from the Program, and can be reasonably considered independent and separate works in themselves, then this License, and its terms, do not apply to those sections when you distribute them as separate works. But when you distribute the same sections as part of a whole which is a work based on the Program, the distribution of the whole must be on the terms of this License, whose permissions for other licensees extend to the entire whole, and thus to each and every part regardless of who wrote it. Thus, it is not the intent of this section to claim rights or contest your rights to work written entirely by you; rather, the intent is to exercise the right to control the distribution of derivative or collective works based on the Program. In addition, mere aggregation of another work not based on the Program with the Program (or with a work based on the Program) on a volume of a storage or distribution medium does not bring the other work under the scope of this License. 3. You may copy and distribute the Program (or a work based on it, under Section 2) in object code or executable form under the terms of Sections 1 and 2 above provided that you also do one of the following: a) Accompany it with the complete corresponding machine-readable source code, which must be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, b) Accompany it with a written offer, valid for at least three years, to give any third party, for a charge no more than your cost of physically performing source distribution, a complete machine-readable copy of the corresponding source code, to be distributed under the terms of Sections 1 and 2 above on a medium customarily used for software interchange; or, c) Accompany it with the information you received as to the offer to distribute corresponding source code. (This alternative is allowed only for noncommercial distribution and only if you received the program in object code or executable form with such (at your option) any later version. This program is distributed in the hope that it will be useful, but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for more details. You should have received a copy of the GNU General Public License along with this program; if not, write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA Also add information on how to contact you by electronic and paper mail. If the program is interactive, make it output a short notice like this when it starts in an interactive mode: Gnomovision version 69, Copyright (C) 19yy name of author Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'. This is free software, and you are welcome to redistribute it under certain conditions; type `show c' for details. The hypothetical commands `show w' and `show c' should show the appropriate parts of the General Public License. Of course, the commands you use may be called something other than `show w' and `show c'; they could even be mouse-clicks or menu items--whatever suits your program. You should also get your employer (if you work as a programmer) or your school, if any, to sign a "copyright disclaimer" for the program, if necessary. Here is a sample; alter the names: Yoyodyne, Inc., hereby disclaims all copyright interest in the program `Gnomovision' (which makes passes at compilers) written by James Hacker. , 1 April 1989 Ty Coon, President of Vice This General Public License does not permit incorporating your program into proprietary programs. If your program is a subroutine library, you may consider it more useful to permit linking proprietary applications with the library. If this is what you want to do, use the GNU Library General Public License instead of this License. ethereal-1.0.0/realm.plx100755 0 0 20013 7053646576 13246 0ustar rootroot#!/bin/perl ################################################################################# # Created : Martin Foster # Modified : 02/19/2000 ################################################################################# # # Realm - Script part of Webchat designed to use the realms # Copyright (C) 2000 Martin Foster # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # # Author of this script can be contacted at the following: # E-Mail : mfoster@redwhite.com # Address : Suite 209 - 355 5th Ave NE # Calgary, Alberta # T2R 0K9 # ################################################################################# use CGI qw(:standard); # Common gateway interface use CGI::Carp qw(fatalsToBrowser); # CGI Error logs use strict; # Strict variable enforcement use FileHandle; # Filehandle use Webchat::Comm; # Communication handler use Webchat::Database; # Database handler use Webchat::Dbm; # DBM Addition use Webchat::Login; # Login functionality use Webchat::Param; # Parameter control use Webchat::Post; # Post handler use Webchat::Who; # Who is on ################################################################################# # Data Members ################################################################################# my $Database; # Database handle my $cgi; # Common gateway interface handle my $javascript; # Javascript preferences my $chatpref; # Chat preferences my $inline; # Inline parameters my $url; # URL path my %param; # Parameter hash my %realm; # Realm hash ################################################################################# # Program Area ################################################################################# $cgi = new CGI; # Create CGI Handle $url = $cgi->url(); # URL Webchat::Database::DatabaseConnect(\$Database); # Connect to MySQL Webchat::Param::GetParam($cgi, \%param); # Retreive parameters Webchat::Dbm::DBMOpenRealm(\%realm); # Link DBM to hash if ( Webchat::Login::GetVerificationNormal($Database, $cgi, \%param) ) { # Make sure logins are possible CheckLegality($Database, $cgi, \%param, \%realm); # Retreive javascript and chat preferences ($javascript, $chatpref) = Webchat::Database::DataGetChatOptions($Database, Webchat::Login::Unmangle($param{'USER'})); # Handle post writing Webchat::Comm::DataWrite($Database, \%param); # Framed chat if (($chatpref eq 'framed') && ($javascript eq 'yes')) { # Only do following if called with no parameters unless ((defined($param{'MAIN'})) || (defined($param{'COMM'}))) { # Retreive parameter list $inline = Webchat::Param::EmbedInline($Database, $cgi, \%param); # Print file header print $cgi->header(); # Print header print "\n\t$param{'ROOM'}\n\n\n"; # Print frameset print "\n"; print "\t\n"; print "\t\n"; print "\n"; print $cgi->end_html(); # End HTML document } # Message display area if (defined($param{'MAIN'})) { # File and HTML header print $cgi->header(-target=>'main'); print $cgi->start_html(-title=>$param{'ROOM'}, -onLoad=>'CommReset()'), "\n"; # Posting related Webchat::Post::HandlePosts($Database, \%param); $inline = Webchat::Param::EmbedInline($Database, $cgi, \%param); # Javascript print "\n\n"; # Activation button print "$realm{'TagPost'}"; print $cgi->end_html(); } # Comm panel if (defined($param{'COMM'})) { Webchat::Comm::CommIndependant($Database, $cgi, \%param); } } # Streaming chat elsif ($chatpref eq 'stream') { # Only do following if called with no parameters unless ((defined($param{'MAIN'})) || (defined($param{'COMM'}))) { # Retreive parameter list $inline = Webchat::Param::EmbedInline($Database, $cgi, \%param); # Print file header print $cgi->header(); # Print header print "\n\t$param{'ROOM'}\n\n\n"; # Print frameset print "\n"; print "\t\n"; print "\t\n"; print "\n"; print $cgi->end_html(); # End HTML document } # Message display area if (defined($param{'MAIN'})) { # Flush standard output autoflush STDOUT 1; print ""; # File header print $cgi->header(-target=>'main'); # Posting related Webchat::Database::DocumentGetHeader($Database); Webchat::Post::HandleStream($Database, \%param); print $cgi->end_html(); } # Comm panel if (defined($param{'COMM'})) { Webchat::Comm::CommStream($Database, $cgi, \%param); } } # Basic chat system else { # Print file and HTML header print $cgi->header(); Webchat::Database::DocumentGetHeader($Database); # Message display and posting Webchat::Post::HandlePosts($Database, \%param); Webchat::Comm::CommDependant($Database, $cgi, \%param); # HTML footer Webchat::Database::DocumentGetFooter($Database); } } Webchat::Dbm::DBMClose(\%realm); # Link DBM to hash $Database->disconnect(); # Disconnect database handle ################################################################################# # Sub-Routines ################################################################################# #################### # Check Legality # # Determins the legality of the user using the currently selected realm. This # will also verify if a realm and puppet were selected. sub CheckLegality # Database, parameters, realm HASH { #################### # Data members my $database = shift; # Database handle my $cgi = shift; # Cgi handle my $param = shift; # Parameter list my $realm = shift; # Realm list my $verdict; # To be or not to be my $redirect; # Redirect information #################### # Program area # Unmangling of information $param->{'ROOM'} = Webchat::Login::Unmangle($param->{'ROOM'}); $param->{'CHAR'} = Webchat::Login::Unmangle($param->{'CHAR'}); $param->{'USER'} = Webchat::Login::Unmangle($param->{'USER'}); # Verification of needed information if ((defined($param->{'ROOM'})) && (defined($param->{'CHAR'}))) { # Verification of access ($verdict) = Webchat::Database::DataGetBannedStatus($Database, $param->{'USER'}, $param->{'ROOM'}); # Return true if not banned unless (defined($verdict)) { return 1; } } # Redirection # Retreive inline parameters $redirect = Webchat::Param::EmbedInline($Database, $cgi, $param); # Redirection header print $cgi->redirect("$realm->{'LnkPortal'}$redirect"); # Premature exit $Database->disconnect(); # Close database handle Webchat::Dbm::DBMClose($realm); # Unlink DBM exit; # Premature exit } ethereal-1.0.0/server/ 40755 0 0 0 7053646576 12613 5ustar rootrootethereal-1.0.0/server/webchatcmd.plx100755 0 0 23314 7053646576 15564 0ustar rootroot#!/bin/perl -w ################################################################################# # Created : Martin Foster # Modified : 02/03/2000 ################################################################################# # # Webchat Command line - Command line controls part of Webchat # Copyright (C) 2000 Martin Foster # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # # Author of this script can be contacted at the following: # E-Mail : mfoster@redwhite.com # Address : Suite 209 - 355 5th Ave NE # Calgary, Alberta # T2R 0K9 # ################################################################################# use strict; # Strict variable enforcement use Webchat::Database; # Database handler use Webchat::Dbm; # Dbm handler ################################################################################# # Data Members ################################################################################# my $Database; # Database handle my $func = shift @ARGV; # Function command my $type = shift @ARGV; # Type to expire ################################################################################# # Program Area ################################################################################# # Only continue if parameters are sent if (defined($func)) { Webchat::Database::DatabaseConnect(\$Database); # Connect to MySQL # Listing of E-Mails if ($func eq '-list') { ListEmail($Database); } # Expiery control if ($func eq '-expire') { # Specific expire if (defined($type)) { # Bannings if ($type eq 'ban') { ExpireBans($Database); } # Posts elsif ($type eq 'post') { ExpirePosts($Database); } # Puppeteers elsif ($type eq 'puppeteer') { ExpirePuppeteer($Database); } # Private realms elsif ($type eq 'realm') { ExpireRealm($Database); } # Registrations elsif ($type eq 'registration') { ExpireRegistrations($Database); } } # General expire else { # Run though all methods ExpireBans($Database); ExpirePosts($Database); ExpirePuppeteer($Database); ExpireRealm($Database); ExpireRegistrations($Database); } } $Database->disconnect(); # Disconnect database handle } # Display help unless (defined($func)) { print "Webchat Command-Line Interface:\n"; print "Usage: webchatcmd.plx {-list|-expire} [expire]\n\n"; print "-list\n"; print "\tDisplay a list of all E-Mail addresses of members\n\n"; print "-expire\n"; print "\tWill remove expired entires. When called alone all are removed\n"; print "\tor if specified only a specific task will take place as listed\n"; print "\tbelow:\n"; print "\t\tban - Remove old bannings\n"; print "\t\tpost - Remove old posts\n"; print "\t\tpuppeteer - Remove inactive puppeteers\n"; print "\t\trealm - Remove inactive private realms\n"; print "\t\tregistration - Remove old incomplete registrations\n\n"; } ################################################################################# # Sub-Routines ################################################################################# #################### # List EMail # # Is used to simply list of all E-Mail addresses of those who are members of the # chat server. This is useful to embed within Majordomo or other such mailing # list system. sub ListEmail # Database { #################### # Data members my $Database = shift; # Database handle my $puppeteers; # Single puppeteer EMail my @puppeteers; # List of all EMails #################### # Program area # Retreive puppeteers E_Mail addresses Webchat::Database::GetListEMails($Database, \@puppeteers); # Print each E-Mail address foreach $puppeteers (@puppeteers) { print "$puppeteers\n"; } } #################### # Expire Bans # # Will expire all bans older then a certain time. sub ExpireBans { #################### # Data members my $Database = shift; # Database handle my $time; # Stale time my %system; # System hash #################### # Program area # Calculate time Webchat::Dbm::DBMOpenSystem(\%system); $time = (time - ($system{'SetTimeoutBanned'} * $system{'SetTimeDay'})); Webchat::Dbm::DBMClose(\%system); # Remove old posts $Database->do("DELETE FROM PuppeteerRestriction WHERE RestrictionTimestamp < ?", {}, $time); } #################### # Expire Posts # # Will expire all posts which are older then twenty minutes. sub ExpirePosts { #################### # Data members my $Database = shift; # Database handle my $time; # Stale time #################### # Program area # Calculate time $time = (time - 1200); # Remove old posts $Database->do("DELETE FROM Post WHERE PostTimestamp < ?", {}, $time); } #################### # Expire Puppeteer # # Will remove all puppeteers that have lapsed on their membership times. Which # is determine in the system DBM. sub ExpirePuppeteer { #################### # Data members my $Database = shift; # Database handle my $time; # Time in seconds my $puppeteer; # Individual puppeteer my $puppet; # Individual puppet my @puppeteers; # List of puppeteers my @puppets; # List of puppets my %system; # System hash #################### # Program area # Calculate time for which older are destroyed Webchat::Dbm::DBMOpenSystem(\%system); $time = (time - ($system{'SetTimeoutPuppeteer'} * $system{'SetTimeDay'})); Webchat::Dbm::DBMClose(\%system); # Rerieve list of puppeteers Webchat::Database::GetListExpire($Database, \@puppeteers, $time); # Run though list of puppeteers foreach $puppeteer (@puppeteers) { # Retreive list of puppets Webchat::Database::GetListPuppetYours($Database, \@puppets, $puppeteer); # Run though list of puppets while ($puppet = shift @puppets) { # Remove instance of puppets $Database->do("DELETE FROM PuppetInvitation WHERE PuppetName=?", {}, $puppet); $Database->do("DELETE FROM PuppetIgnore WHERE PuppetName=?", {}, $puppet); $Database->do("DELETE FROM Puppet WHERE PuppetName=?", {}, $puppet); } # Remove all instances of the puppeteers (except for Audit) $Database->do("DELETE FROM PuppeteerRestriction WHERE PuppeteerLogin=?", {}, $puppeteer); $Database->do("DELETE FROM PuppeteerRegistration WHERE PuppeteerLogin=?", {}, $puppeteer); $Database->do("DELETE FROM PuppeteerSupervisor WHERE PuppeteerLogin=?", {}, $puppeteer); $Database->do("DELETE FROM PuppetIgnore WHERE PuppeteerLogin=?", {}, $puppeteer); $Database->do("DELETE FROM Puppeteer WHERE PuppeteerLogin=?", {}, $puppeteer); } } #################### # Expire Realm # # Will remove all private realms after elapsed time. sub ExpireRealm { #################### # Data members my $Database = shift; # Database handle my $Statement; # SQL Statement my $time; # Time in seconds my $realm; # Individual puppeteer my %system; # System hash #################### # Program area # Calculate time for which older are destroyed Webchat::Dbm::DBMOpenSystem(\%system); $time = (time - ($system{'SetTimeoutRealm'} * $system{'SetTimeDay'})); Webchat::Dbm::DBMClose(\%system); # Prepare and execute $Statement = $Database->prepare("SELECT RealmName FROM Realm WHERE RealmPublic='no' AND RealmTimestamp < ?"); $Statement->execute($time); # Run though list while ($realm = $Statement->fetchrow()) { # Remove affected entries $Database->do("DELETE FROM Post WHERE RealmName=?", {}, $realm); $Database->do("DELETE FROM WordRestriction WHERE RealmName=?", {}, $realm); $Database->do("DELETE FROM RealmSupervisor WHERE RealmName=?", {}, $realm); $Database->do("DELETE FROM PuppetInvitation WHERE RealmName=?", {}, $realm); $Database->do("DELETE FROM PuppeteerRestriction WHERE RealmName=?", {}, $realm); $Database->do("DELETE FROM Realm WHERE RealmName=?", {}, $realm); } $Statement->finish(); # End query } #################### # Expire Registrations # # Will expire all registration older then a certain taime who have not completed # their registration. sub ExpireRegistrations { #################### # Data members my $Database = shift; # Database handle my $Statement; # Sql Statement my $time; # Stale time my $puppeteer; # Individual puppeteer my %system; # System hash #################### # Program area # Calculate time Webchat::Dbm::DBMOpenSystem(\%system); $time = (time - ($system{'SetTimeoutRegister'} * $system{'SetTimeDay'})); Webchat::Dbm::DBMClose(\%system); # Initialize and execute $Statement = $Database->prepare("SELECT PuppeteerLogin FROM PuppeteerRegistration WHERE PuppeteerTimeStamp < ?"); $Statement->execute($time); # Cycle though list while ($puppeteer = $Statement->fetchrow()) { # Remove unregistered puppeteers $Database->do("DELETE FROM Puppeteer WHERE PuppeteerLogin=?", {}, $puppeteer); $Database->do("DELETE FROM PuppeteerRegistration WHERE PuppeteerLogin=?", {}, $puppeteer); } $Statement->finish(); # End query }