#!/usr/bin/perl
# on2me commons free beta version 4825
# This file is copyright 2004 Jeremie Miller <jeremie@jeremie.com>
# It is free to use and redistribute under the following simple rules:
#  - It can't be modified except for the below configureable options
#  - Don't blame me if something bad happens resulting from using this
#  - For personal/non-profit use only, no commercial or ad-supported sites
# If you those rules to your dismay, just upgrade (it's only $5 right now) 
# and you get lots more freedom and features, and I'll sincerely appreciate it too!

# This is the one configurable option, the path to the shared data file.
# Only change this if there are multiple versions of this running on the same server,
# then each one should have their own file:
$data = "/tmp/on2me_commons"; 

# I've put some considerable time into getting this simple but solid works-anywhere perl back-end working too,
# so besides breaking the rules, please respect the time and effort I put into this and not bother trying to decode it,
# just visit on2me.com and upgrade to the commons basic (it's cheap!) and get the nicely commented version.
$hj61 = 300; $ajgo = 60; %heeb = ("available"=>3000,"away"=>10000,"xa"=>20000,"offline"=>-1); $e42a = 20000; $fm55 = 60000; %h0ik = &aab(); if($ENV{'HTTP_COOKIE'} =~ /on2sid\=(\w+)/) { $bj6e = $1; }else{ $bj6e = aaf(); $fn6h=gmtime(time()+365*24*3600)." GMT"; print "Set-Cookie: on2sid=$bj6e; path=/; expires=$fn6h;\r\n"; } my %k2ca; my %cp59; my %j02m; my %iagn; my %bdlc; my $j59j; my $e3fp; open(DAT,"<$data"); while(<DAT>) { chop(); next unless($_ =~ /\t/); my ($hnon,$fj3i,$h3bg,$ih9j) = split(/\t/); next unless($hnon > 0); $j59j = $hnon if($hnon > $j59j); $k2ca{$fj3i} = $hnon if($h3bg eq "pres" && $hnon > $k2ca{$fj3i}); $cp59{$fj3i} = $hnon if($h3bg eq "nick" && $hnon > $cp59{$fj3i}); $j02m{$ih9j} = $fj3i if($h3bg eq "nick"); $iagn{$fj3i} = $hnon if($h3bg eq "session"); $bdlc{$hnon} = {sid=>$fj3i,txt=>$ih9j,type=>$h3bg}; } close(DAT); if($h0ik{seq} <= 0 || !$iagn{$bj6e}) { $jhoo = 0; &aaj("session","$ENV{'REMOTE_ADDR'}") if(!$iagn{$bj6e}); $iagn{$bj6e} = $j59j; if($ENV{'HTTP_COOKIE'} =~ /on2nick\=([^;]+)/) { $c0og=$1; }else{ $c0og="anon"; } &aak($c0og); delete $k2ca{$bj6e}; }else{ $jhoo = $h0ik{seq}; $cahk = $iagn{$bj6e}; $iagn{$bj6e} = &aac(); $bdlc{$iagn{$bj6e}} = $bdlc{$cahk}; delete $bdlc{$cahk}; } &aae(); if($h0ik{chat}) { $h0ik{chat} = &aag($h0ik{chat},200); if($h0ik{to}) { &aaj("private","$h0ik{to}:$h0ik{chat}"); }else{ &aaj("chat",$h0ik{chat}); } } &aak($h0ik{nick}) if($h0ik{nick}); &aad(); sub aag { my($ih9j,$d9i3) = @_; $ih9j =~ s/<a[^>]*[\W]+([\w|\.|\-]+\.[\w]{2,}[^\s|>|\'|\"]*)[^>]*>/ $1 /g; $ih9j =~ s/<[^>]*>//g; $ih9j = substr($ih9j,0,$d9i3) if(length($ih9j) > $d9i3); $ih9j =~ s/(([\w|\.|\-]+\.[\w]{2,})[^\s|<]*)/<a href\=\'http\:\/\/$1\' target\=\_new>$2<\/a>/g; return $ih9j; } sub aak { my($c0og) = @_; $c0og =~ s/\W//g; $c0og = substr($c0og,0,12) if(length($c0og) > 12); return if($j02m{$c0og} eq $bj6e); while($j02m{$c0og}) { $c0og =~ s/(\d+)\z//; $fjkn = ($1 > 0) ? $1 : 1; $c0og .= ++$fjkn; } $fn6h=gmtime(time()+365*24*3600)." GMT"; print "Set-Cookie: on2nick=$c0og; path=/; expires=$fn6h;\r\n"; &aaj("nick",$c0og); } sub aae { my($f32j,@ae1p) = split(/\:/,$bdlc{$k2ca{$bj6e}}->{txt}); my($g742) = join("@",@ae1p); $g742 = &aag($g742,64); if($h0ik{status}) { return if(!$heeb{$h0ik{status}}); if($h0ik{status} eq "available" && !$h0ik{msg}) { &aaj("pres",$h0ik{status}); }else{ &aaj("pres","$h0ik{status}\:$h0ik{msg}"); } $e3fp .= "rate\@$heeb{$h0ik{status}}*"; return; } my($h5jb) = &aai($f32j); return if(length($g742) > 0 || $bdlc{$k2ca{$bj6e}}->{txt} eq $h5jb); $e3fp .= "rate\@$heeb{$h5jb}*"; &aaj("pres",$h5jb); } sub aai { my $ico6 = "available"; $ico6 = "away" if($h0ik{idle} > $e42a); $ico6 = "xa" if($h0ik{idle} > $fm55); return $ico6; } sub aad { my @i260; foreach $e7pm (keys(%iagn)) { if($iagn{$e7pm} < ($j59j - $hj61)) { delete $iagn{$e7pm}; next; } if($iagn{$e7pm} < (time() - $ajgo) && $bdlc{$k2ca{$e7pm}}->{txt} ne "offline") { $ale7 = &aac(); $k2ca{$e7pm} = $ale7; $bdlc{$ale7} = {sid=>$e7pm,txt=>"offline",type=>"pres"}; } } open(DAT,">$data"); flock(DAT,2); seek(DAT,0,0); foreach $hnon (keys(%bdlc)) { $ebi0 = $bdlc{$hnon}; next if(!$iagn{$ebi0->{sid}}); if($ebi0->{type} eq "nick"){ next if($hnon != $cp59{$ebi0->{sid}}); }elsif($ebi0->{type} eq "pres"){ next if($hnon != $k2ca{$ebi0->{sid}}); }else{ next if($hnon < ($j59j - $hj61)); } push(@i260,$hnon) if($hnon > $jhoo && $ebi0->{type} ne "session"); next if($hnon < $jhoo && $ebi0->{type} eq "private" && $ebi0->{txt} =~ /(\w+)\:.+/ && $1 eq $bj6e); print DAT "$hnon\t$ebi0->{sid}\t$ebi0->{type}\t$ebi0->{txt}\n"; } close(DAT); foreach $hnon (sort {$ckml < $fckc} @i260) { $ebi0 = $bdlc{$hnon}; if($ebi0->{type} eq "private") { $e3fp .= "private\@$ebi0->{sid}\@".aah($2)."*" if($ebi0->{txt} =~ /(\w+)\:(.+)/ && $1 eq $bj6e); }elsif($ebi0->{type} eq "pres"){ $e3fp .= "$ebi0->{type}\@$ebi0->{sid}\@".aah($ebi0->{txt})."\@".aah($bdlc{$iagn{$ebi0->{sid}}}->{txt})."*"; }else{ $e3fp .= "$ebi0->{type}\@$ebi0->{sid}\@".aah($ebi0->{txt})."*"; } if(length($e3fp) > 3500) { $j59j = $hnon; break; } } print "Set-Cookie: on2CC=seq\@$j59j*$e3fp; path=/;\r\n"; print "Content-type: image/gif\r\n\r\n"; open(PIX,"pix.gif"); while(<PIX>){ print $_;} close(PIX); exit(); } sub aac { $c6pd = time(); $j59j = ($c6pd > $j59j) ? $c6pd : ($j59j + 0.01); return $j59j; } sub aaj { my ($h3bg,$ih9j) = @_; $ih9j =~ s/\s/ /g; my ($ale7) = &aac(); $cp59{$bj6e} = $ale7 if($h3bg eq "nick"); $k2ca{$bj6e} = $ale7 if($h3bg eq "pres"); $bdlc{$ale7} = {sid=>$bj6e,txt=>$ih9j,type=>$h3bg}; } sub aaf { my @f6m4=('a'..'z','0'..'9'); my $bj6e; foreach(1..32) { $bj6e .= $f6m4[rand @f6m4]; } return $bj6e; } sub aab { local($e7pm, $fno9, $b7n0, %hjmo); if($ENV{'REQUEST_METHOD'} eq "GET") { $hjmo = $ENV{'QUERY_STRING'}; } elsif($ENV{'REQUEST_METHOD'} eq "POST") { read(STDIN,$hjmo,$ENV{'CONTENT_LENGTH'}); } @hjmo = split(/&/,$hjmo); foreach $e7pm (0 .. $#hjmo) { $hjmo[$e7pm] =~ s/\+/ /g; ($fno9, $b7n0) = split(/=/,$hjmo[$e7pm],2); $fno9 =~ s/%(..)/pack("c",hex($1))/ge; $b7n0 =~ s/%(..)/pack("c",hex($1))/ge; $hjmo{$fno9} .= "\0" if (defined($hjmo{$fno9})); $hjmo{$fno9} .= $b7n0; } return %hjmo; } sub aah { my($hp5j) = $_[0]; $hp5j =~ s/[^A-Za-z0-9\ \_\.\-]/uc sprintf("%%%02x",ord($&))/egx; $hp5j =~ tr/ /+/; return $hp5j; }