sulfericacid
Programmer
Same person, same script, different problem I asked on four different places and no one had any idea what was causing this behavior.
Problem: Plain text messages under 500 or so characters will feed through script properly (tested to 60 messages without problems). But once you provoke a substitution (using an emoticon) the script will freeze within 15 posts of the first time you used it. No matter how many times you use an emoticon, the script WILL freeze within 15 messages. By freeze I mean the database loses it's insertion order and tosses messages in whichever order it feels like.
I know the code below is quite long but since no one has any idea where the problem is I thought it'd be better if you could see the script. Still testable at [].
Any suggestions on what could be the problem or what should be changed to better the script would be much appreciated. I've been stuck on this specific problem for over two weeks now.
Thank you!
#!/usr/bin/perl -w
open( STDERR, ">>/home/sulfericacid/public_html/error.log" )
or die "Cannot open error log, weird...an error opening an error log: $!";
use strict;
use warnings;
use POSIX;
use CGI qwstandard start_table end_table);
require SDBM_File;
my %chat;
my %chatorder;
my @words = ();
my $chat = "list.dbm"; # location of database
my $file = "count.txt"; # location of count file
my $url = "my $imagedir =
" ; # location of image directory (emoticons)
use Tie::IxHash;
my $columns = 50;
use Text::Wrap qw( wrap $columns );
tie %chat, "Tie::IxHash";
tie %chatorder, "Tie::IxHash";
tie( %chat, 'SDBM_File', $chat, O_CREAT | O_RDWR, 0644 )
or die "Couldn’t tie SDBM file '$chat' $!; aborting";
if ( !tied %chat ) {
print "database unsuccessful $!.\n";
}
my $js = "<script langauge=\"Javascript\">
document.write('<form><input type=button value=\"Refresh\" onClick=\"window.location.reload()\"></form>');</script></noscript></noscript>";
#
# Time to keep accurate logs
#
my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) =
localtime(time);
print header, start_html;
my $num;
foreach ( keys(%chat) ) {
$num++;
}
print "DB keys: $num";
my $name = param('name');
my $message = param('message');
my $cnt;
if (param) {
if ($name) {
if ($message) {
open( LOG, "$file" ); # open count log for ID
$cnt = <LOG>;
close(LOG);
$cnt++;
open( LOG, "> $file" );
print LOG $cnt;
close(LOG);
$name =~ s/</<\;/g; # removing exploit
$message =~ s/</<\;/g; # removing exploit
my $keeptime = join ( ':', $hour, $min, $sec );
my $info = join ( '::', $name, $message, $keeptime );
$chat{$cnt} = $info;
}
else {
print "Message was missing, data not sent.<br>";
}
}
else {
print "Name was missing, data not sent.<br>";
}
}
print "(<a href=\"log.pl\" target=\"new\">chat logs</a>)";
print "the local time is $hour:$min:$sec";
print start_table;
print Tr(
td(
{ -height => '5', width => '700', bgcolor => '#BBCCEE' },
"<font size=2><b>ChatterBox version 1.0</b> $hour:$min:$sec</font>"
)
);
print Tr( td( { -height => '5', width => '700', bgcolor => '#BBCCEE' }, "" ) );
my $add;
foreach ( reverse keys(%chat) ) {
$add++;
if ( $add <= 10 ) {
$chatorder{$_} = $chat{$_};
}
}
foreach ( reverse keys(%chatorder) ) {
my ( $name, $message, $time ) = split /::/, $chatorder{$_};
$name =~ s/$_/****/g for @words; # say goodbye to swear words
$message =~ s/$_/****/g for @words; # say goodbye to swear words
$message =~ s#:\)#<img src="$imagedir/smiley.gif">#g; # happy emoticon
$message =~ s#:\(#<img src="$imagedir/sad.gif">#g; # sad emoticon
$message =~ s##<img src="$imagedir/tongue.gif"#g; # tongue emoticon
$message =~ s##<img src="$imagedir/tongue.gif">#g; # tongue1 emoticon
$message =~ s##<img src="$imagedir/oh.gif">#g; # oh emoticon
$message =~ s#:O#<img src="$imagedir/oh.gif">#g; # oh1 emoticon
$message =~ s#\*hug\*#<img src="$imagedir/hug.gif">#g; # hug emoticon
$message =~
s#\*flower\*#<img src="$imagedir/flower.gif">#g; # flower emoticon
$message =~ s#\*wink\*#<img src="$imagedir/wink.gif">#g; # wink emoticon
$message =~ s#\*devil\*#<img src="$imagedir/devil.gif">#g; # devil emoticon
$message =~ s#\*love\*#<img src="$imagedir/love.gif"\>#g; # love emoticon
$message =~ s#\*sleep\*#<img src="$imagedir/sleep.gif">#g; # sleep emoticon
$message =~
s#\*conf\*#<img src="$imagedir/confused.gif">#g; # sleep emoticon
$message = wrap( '', '', $message );
print Tr(
td(
{ -width => '700' },
"<font color=blue><$name @ $time></font>$message"
)
),
}
print Tr( td( { -height => '5', width => '700', bgcolor => '#BBCCEE' }, "" ) );
print Tr(
td(
{ -height => '5', width => '700', bgcolor => '#BBCCEE' },
"<font size=2><p align=right><b> )
);
print start_form( -action => $url ), table(
Tr(
td("Name: ",
td(
textfield(
-name => 'name',
-size => 40
)
)
),
Tr(
td("Message: ",
td(
textfield(
-name => 'message',
-size => 100,
-force => 1,
)
)
),
Tr( td(), td( submit('send'), $js ), ),
end_form(),
hr(),
);
"Age is nothing more than an inaccurate number bestowed upon each of us at birth as just another means for others to judge and classify us- sulfericacid
Problem: Plain text messages under 500 or so characters will feed through script properly (tested to 60 messages without problems). But once you provoke a substitution (using an emoticon) the script will freeze within 15 posts of the first time you used it. No matter how many times you use an emoticon, the script WILL freeze within 15 messages. By freeze I mean the database loses it's insertion order and tosses messages in whichever order it feels like.
I know the code below is quite long but since no one has any idea where the problem is I thought it'd be better if you could see the script. Still testable at [].
Any suggestions on what could be the problem or what should be changed to better the script would be much appreciated. I've been stuck on this specific problem for over two weeks now.
Thank you!
#!/usr/bin/perl -w
open( STDERR, ">>/home/sulfericacid/public_html/error.log" )
or die "Cannot open error log, weird...an error opening an error log: $!";
use strict;
use warnings;
use POSIX;
use CGI qwstandard start_table end_table);
require SDBM_File;
my %chat;
my %chatorder;
my @words = ();
my $chat = "list.dbm"; # location of database
my $file = "count.txt"; # location of count file
my $url = "my $imagedir =
" ; # location of image directory (emoticons)
use Tie::IxHash;
my $columns = 50;
use Text::Wrap qw( wrap $columns );
tie %chat, "Tie::IxHash";
tie %chatorder, "Tie::IxHash";
tie( %chat, 'SDBM_File', $chat, O_CREAT | O_RDWR, 0644 )
or die "Couldn’t tie SDBM file '$chat' $!; aborting";
if ( !tied %chat ) {
print "database unsuccessful $!.\n";
}
my $js = "<script langauge=\"Javascript\">
document.write('<form><input type=button value=\"Refresh\" onClick=\"window.location.reload()\"></form>');</script></noscript></noscript>";
#
# Time to keep accurate logs
#
my ( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) =
localtime(time);
print header, start_html;
my $num;
foreach ( keys(%chat) ) {
$num++;
}
print "DB keys: $num";
my $name = param('name');
my $message = param('message');
my $cnt;
if (param) {
if ($name) {
if ($message) {
open( LOG, "$file" ); # open count log for ID
$cnt = <LOG>;
close(LOG);
$cnt++;
open( LOG, "> $file" );
print LOG $cnt;
close(LOG);
$name =~ s/</<\;/g; # removing exploit
$message =~ s/</<\;/g; # removing exploit
my $keeptime = join ( ':', $hour, $min, $sec );
my $info = join ( '::', $name, $message, $keeptime );
$chat{$cnt} = $info;
}
else {
print "Message was missing, data not sent.<br>";
}
}
else {
print "Name was missing, data not sent.<br>";
}
}
print "(<a href=\"log.pl\" target=\"new\">chat logs</a>)";
print "the local time is $hour:$min:$sec";
print start_table;
print Tr(
td(
{ -height => '5', width => '700', bgcolor => '#BBCCEE' },
"<font size=2><b>ChatterBox version 1.0</b> $hour:$min:$sec</font>"
)
);
print Tr( td( { -height => '5', width => '700', bgcolor => '#BBCCEE' }, "" ) );
my $add;
foreach ( reverse keys(%chat) ) {
$add++;
if ( $add <= 10 ) {
$chatorder{$_} = $chat{$_};
}
}
foreach ( reverse keys(%chatorder) ) {
my ( $name, $message, $time ) = split /::/, $chatorder{$_};
$name =~ s/$_/****/g for @words; # say goodbye to swear words
$message =~ s/$_/****/g for @words; # say goodbye to swear words
$message =~ s#:\)#<img src="$imagedir/smiley.gif">#g; # happy emoticon
$message =~ s#:\(#<img src="$imagedir/sad.gif">#g; # sad emoticon
$message =~ s##<img src="$imagedir/tongue.gif"#g; # tongue emoticon
$message =~ s##<img src="$imagedir/tongue.gif">#g; # tongue1 emoticon
$message =~ s##<img src="$imagedir/oh.gif">#g; # oh emoticon
$message =~ s#:O#<img src="$imagedir/oh.gif">#g; # oh1 emoticon
$message =~ s#\*hug\*#<img src="$imagedir/hug.gif">#g; # hug emoticon
$message =~
s#\*flower\*#<img src="$imagedir/flower.gif">#g; # flower emoticon
$message =~ s#\*wink\*#<img src="$imagedir/wink.gif">#g; # wink emoticon
$message =~ s#\*devil\*#<img src="$imagedir/devil.gif">#g; # devil emoticon
$message =~ s#\*love\*#<img src="$imagedir/love.gif"\>#g; # love emoticon
$message =~ s#\*sleep\*#<img src="$imagedir/sleep.gif">#g; # sleep emoticon
$message =~
s#\*conf\*#<img src="$imagedir/confused.gif">#g; # sleep emoticon
$message = wrap( '', '', $message );
print Tr(
td(
{ -width => '700' },
"<font color=blue><$name @ $time></font>$message"
)
),
}
print Tr( td( { -height => '5', width => '700', bgcolor => '#BBCCEE' }, "" ) );
print Tr(
td(
{ -height => '5', width => '700', bgcolor => '#BBCCEE' },
"<font size=2><p align=right><b> )
);
print start_form( -action => $url ), table(
Tr(
td("Name: ",
td(
textfield(
-name => 'name',
-size => 40
)
)
),
Tr(
td("Message: ",
td(
textfield(
-name => 'message',
-size => 100,
-force => 1,
)
)
),
Tr( td(), td( submit('send'), $js ), ),
end_form(),
hr(),
);
"Age is nothing more than an inaccurate number bestowed upon each of us at birth as just another means for others to judge and classify us- sulfericacid