www.pudn.com > coolchat.zip > basefun.pl
sub GetCookies
{
my @cstuff = @_;
my ($cookie, $value, $char, %cookie);
my @Cdec = ('\+', '\%3A\%3A', '\%3D', '\%2C', '\%25', '\%2B', '\%26','\%3B');
my %Cdec = ('\+',' ','\%3A\%3A','::','\%3D','=','\%2C',',','\%25','%','\%2B','+','\%26','&','\%3B',';');
if ($ENV{'HTTP_COOKIE'})
{
foreach (split(/; /,$ENV{'HTTP_COOKIE'}))
{
($cookie,$value) = split(/=/);
foreach $char (@Cdec)
{
$cookie =~ s/$char/$Cdec{$char}/g;
$value =~ s/$char/$Cdec{$char}/g;
}
$cookie{$cookie} = $value;
}
}
return %cookie;
}
sub check_Cookie
{
my $action = shift;
return if($action eq "cg");
$UserData{'Color'} = "#0000FF" if($UserData{'Color'} !~ /^#[\dabcdef]{6}$/i);
$UserData{'Nick'} = &RemoveSpecialChar($UserData{'Nick'});
$UserData{'Nick'} = $UserData{'User'} if(length($UserData{'Nick'}) < 3);
#&somerror("对不起, 请重新登录一次!","$ChatURLpath",1) if($UserData{'Time'} + $MaxIdelTime < time);
&somerror("出错了, 您没有登录或者你没有打开浏览器Cookie选项!","$ChatURLpath",1) if(($UserData{'User'} eq "")||($UserData{'Room'} eq "")||($UserData{'Key'} eq ""));
MyDo $do_checkrand;
&somerror("出错了, 你的在线数据有问题!","$ChatURLpath",1) if (&checkrand($UserData{'User'},$UserData{'Key'},$UserData{'Room'}) ne 0);
$UserData{'UsrAction'} =~ s/\D//g;
$UserData{'UsrAction'} = 0 if($UserData{'UsrAction'} < 1);
$UserData{'Group'} =~ s/\D//g;
if($UserData{'Group'} eq 99)
{
MyDo $do_chatgetright;
($UserData{'Right'},$UserData{'Group'}) = &getright($UserData{'User'});
}
}
sub SetCookies
{
my $exptime = shift;
my(@days) = ("Sun","Mon","Tue","Wed","Thu","Fri","Sat");
my(@months) = ("Jan","Feb","Mar","Apr","May","Jun","Jul","Aug","Sep","Oct","Nov","Dec");
if($exptime ne 0)
{
$exptime += time;
my($seconds,$min,$hour,$mday,$mon,$year,$wday) = gmtime($exptime);
$seconds = "0".$seconds if $seconds < 10;
$min = "0".$min if $min < 10;
$hour= "0".$hour if $hour < 10;
$exptime = "$days[$wday], $mday-$months[$mon]-$year $hour:$min:$seconds GMT";
}
my @cookies = @_;
my($cookie,$value,$char);
my @Cenc = ('\;','\&','\+','\%','\,','\=','\:\:','\s');
my %Cenc = ('\;','%3B','\&','%26','\+','%2B','\%','%25','\,','%2C','\=','%3D','\:\:','%3A%3A','\s','+');
while( ($cookie,$value) = @cookies )
{
foreach $char (@Cenc)
{
$cookie =~ s/$char/$Cenc{$char}/g;
$value =~ s/$char/$Cenc{$char}/g;
}
print 'Set-Cookie: ' . $cookie . '=' . $value . ';';
print ' expires='.$exptime.';' if ($exptime ne 0);
print "\n";
shift(@cookies); shift(@cookies);
}
}
#Get data from user
sub get_form_data
{
$buffer = "";
read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});
&somerror("The data you input are too long!!") if($ENV{'CONTENT_LENGTH'} > $MaxMessageLen);
@pairs=split(/&/,$buffer);
foreach $pair (@pairs)
{
@a = split(/=/,$pair);
$name=$a[0];
$value=$a[1];
$value=~tr/+/ /;
$name =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge;
$value =~ s/%([A-Fa-f0-9]{2})/pack("c",hex($1))/ge;
my($i,$binchar,$tempvalue,$strlen) = ();
$strlen = length($value);
for ($i = 0; $i < $strlen; $i++)
{
my $binchar = vec($value, $i, 8);
next if ($binchar < 32);
$tempvalue .= substr($value, $i, 1);
}
$value = $tempvalue;
$value =~ s/:/$colon/g;
my $lowviewid = lc($UserData{'User'});
$first_id='!';
my $idpath = $LOGOpath.$first_id."/";
my $datapath = $idpath.$lowviewid;
if(open(DATA,"<$datapath$DATA"))
{
@userlines=;
close DATA;
}
($logtime,$msgnum,$onlinetime,$experience,$lifevalue,$lastip,$lasttime,$nowip,$nowtime,$tails)=split(/:/,$userlines[0],10);
$level=int($experience/100);
if(($UserData{'Group'} <=70)&&($level <=70))
{
$value =~s /%3c/</gi;
$value =~s /%3e/>/gi;
$value =~s />/>/g;
$value =~s /$lf.lock");
flock(LOCK,2);
print LOCK "u";
}
}
sub unlock # unlocks a lock file
{
my($lf) = shift; # the lock file name
if(!$Enable_Flock)
{
&unlock_NT($lf);
} else
{
close(LOCK);
flock(LOCK,8);
unlink "$lf.lock";
}
}
sub lock_NT # lock variant for system that do not support flock()
{
my($lf) = shift; # the lock file name
my($i,$time,$busy,$d) = ();
$i = 0; $busy = 1;
while($busy)
{
while(( -e "$lf.lock") && ($i < 4))
{
sleep(1);
$i ++;
}
if($i == 4)
{
if(open BILLOWCAT, "$lf.lock")
{
$d = ;
close BILLOWCAT;
}
if(time - $d > 10)
{
$busy = 0;
}
}
else
{
$busy = 0;
}
$i = 0;
}
open(LOCK,">$lf.lock");
print LOCK time;
close(LOCK);
}
sub unlock_NT # unlock variant for system that do not support flock()
{
my($lf) = shift; # the lock file name
unlink("$lf.lock");
}
sub convert_time
{
my $time = shift;
my $timeformat = shift;
$time = localtime($time);
if($timeformat eq "1")
{
my @tarray = split(/ +/,$time);
my %months = (
"Jan" => 1,
"Feb" => 2,
"Mar" => 3,
"Apr" => 4,
"May" => 5,
"Jun" => 6,
"Jul" => 7,
"Aug" => 8,
"Sep" => 9,
"Oct" => 10,
"Nov" => 11,
"Dec" => 12
);
my $year = substr($tarray[4],2,2);
$time = "$months{$tarray[1]}-$tarray[2]-$year";
}
return $time;
}
#State,$ID,$room,$nickname,$message,$towho,$private
sub UpdateChatData
{
my($state,$id,$room,$nickname,$message,$towho,$private) = @_;
my $timenum = time;
$id = lc($id);
$towho=lc($towho);
my ($i,$msglines,$halfmsg);
my $useraction = 0;
$useraction = $UserData{'UsrAction'} if(defined $UserData{'UsrAction'});
return if(($message eq "")||($id eq "")||($room eq "")||($nickname eq ""));
$message =~ s/:/$colon/g;
$message =~ s/\n|\r//g;
$message =~ s/\\/\\\\/g;
$message =~ s/\"/\\\"/g;
$message =~ s/\'/\\\'/g;
my $today = &convert_time(time,1);
&lock("$chatdatadir/day/$today-$room$MSG");
if(open(MSG,">>$chatdatadir/day/$today-$room$MSG"))
{
print MSG "$id:$private:$towho:$state:$message:$nickname:$UserData{'Color'}:$useraction:$timenum:$ENV{'REMOTE_ADDR'}:0:E\n";
close MSG;
}
&unlock("$chatdatadir/day/$today-$room$MSG");
&lock("$chatdatadir/$room$MSG");
if(open(MSG,"$chatdatadir/$room$MSG"))
{
@msglines = ;
$msglines = @msglines;
if($msglines > $MaxMsgLine)
{
$halfmsg = int($msglines/2);
if(open(MSG,">$chatdatadir/$room$MSG"))
{
print MSG $msglines[0] + $halfmsg - 1;
print MSG "\n";
for($i=$halfmsg;$i<$msglines;$i++)
{
print MSG $msglines[$i];
}
print MSG "$id:$private:$towho:$state:$message:$nickname:$UserData{'Color'}:$useraction:$timenum:$ENV{'REMOTE_ADDR'}:0:E\n";
close MSG;
&unlock("$chatdatadir/$room$MSG");
return;
}
}
}
&unlock("$chatdatadir/$room$MSG");
if(open(MSG,">>$chatdatadir/$room$MSG"))
{#$id:$private:$towho:$message:$nickname:$timenum:$ENV{'REMOTE_ADDR'}:0:0:E
print MSG "$id:$private:$towho:$state:$message:$nickname:$UserData{'Color'}:$useraction:$timenum:$ENV{'REMOTE_ADDR'}:0:E\n";
close MSG;
}
&unlock("$chatdatadir/$room$MSG");
}
sub chatshowmsg
{
if(defined $formdata{'MsgLine'})
{
require "$CGIfuncpath/chatnewmsg.pl";
&chatnewmsg($formdata{'MsgLine'});
return;
}
else
{
print "";
}
}
sub RemoveSpecialChar
{
my $srctxt = shift;
my $strlen = length($srctxt);
my $result = "";
my ($binchar,$char,$binchar2) = '';
for (my($i) = 0; $i < $strlen; $i++) {
$binchar = vec($srctxt, $i, 8);
if ($binchar <= 127) {
$char = substr($srctxt, $i, 1);
$result .= $char;
}
else
{
$binchar2 = vec($srctxt, $i+1, 8);
if ($binchar >= 164 and $binchar <= 247 and
$binchar2 >= 161 and $binchar2 <= 254) {
$result .= substr($srctxt, $i, 2);
}
$i++;
}
}
return $result;
}
1;