#!/usr/bin/perl use CGI::Thin; use CGI::Thin::Cookies; sub gen_uuid($;$) { my $n = shift; my $c = shift; my $o = ''; if ($c) { for(1..$n) { $o .= (($ch = int(rand(36))) > 9 ? chr(ord('a') + $ch - 10) : $ch); } } else { for(1..$n) { $o .= int(rand(10)); } } if ($o =~ /(f.ck|sh.t|cr.p)/) { return gen_uuid($n, $c); } return $o; } my $doctype = qq{}; @hosts = ( ["irc.surrealchat.net", "http://java.surrealchat.net"] ); #@hosts = ( # ["nascent.surrealchat.net", "http://www.surrealchat.net"], # ["frontier.surrealchat.net", "http://frontier.surrealchat.net/scnet"] #); %cgi = &Parse_CGI(); %cook = &Parse_Cookies(); if($nick = $cgi{'nick'}) { print &Set_Cookie(NAME=>'nick', VALUE=>$nick, DOMAIN=>'.surrealchat.net', EXPIRE=>'never'); } if($password = $cgi{'password'} and $cgi{'savepass'}) { print &Set_Cookie(NAME=>'password', VALUE=>$password, DOMAIN=>'.surrealchat.net', EXPIRE=>'never'); } my $userkey; if(!($userkey = $cook{'key'}) or length($cook{'key'}) > 5 or $cook{'key'} =~ /(f.ck|sh.t|cr.p)/ ) { $userkey = gen_uuid(5, 1); print &Set_Cookie(NAME=>'key', VALUE=>$userkey, DOMAIN=>'.surrealchat.net', EXPIRE=>'never'); } $password = $cook{'password'} unless $password; # The following tests (and inside the else) are for broken browsers/'firewalls' # that break the HTTP_REFERER. Example: 'badly' configured Norton Internet Security # We use $referer for the GECOS field so that java portals may be identified if($cgi{'pokemon'}) { our $pokemon = 1; $cgi{'chan'} = 'PokemonCrater'; $cgi{'ref'} = 'http://www.pokemoncrater.com/'; } if(defined($cgi{'ref'}) and !(($cgi{'ref'} eq '') or ($cgi{'ref'} =~ /^\s+$/))) { $referer = $cgi{'ref'}; } else { if (defined($ENV{HTTP_REFERER}) and !(($ENV{HTTP_REFERER} eq '') or ($ENV{HTTP_REFERER} =~ /^\s+$/))) { $referer = $ENV{HTTP_REFERER}; } else { $referer = 'Unknown portal (broken browser)'; } $cgi{'ref'} = $referer; } if(defined($cgi{'css'})) { $css = $cgi{'css'}; } else { $css = '/default.css'; } if(defined($cgi{'chanlist'})) { $chanlist = $cgi{'chanlist'}; } else { $chanlist = 1; } $nick = $cgi{guestnick} if !$nick and $cgi{guestnick}; unless($nick =~ /^[][a-zA-Z`\\\|{}_][][a-zA-Z0-9`\\\|{}_-]*$/) { if($nick) { $msg = "

Erroneous nickname - nicknames must start with a letter and cannot contain spaces or certain punctuation.

Please enter a different nickname:

"; } else { $cgi{guestnick} = 'Guest'.gen_uuid(5); $msg = "

Please enter a nickname:

"; } $nick = $cook{'nick'} unless $nick; CHAT: print qq{Content-type: text/html $doctype }.($pokemon ? 'PokemonCrater' : 'SurrealChat.net').qq{ Java Chat
}; if($pokemon) { print qq{

NOTICE:

If PokemonCrater won\'t let you log in, the people in the chat room DON\'T KNOW why it\'s not working and WE CAN\'T DO ANYTHING. We don\'t know how long it will take either. Sorry.

}; } else { print qq{}; } print qq{ $msg

}; foreach $k (keys(%cgi)) { next if $k eq 'nick'; print qq{\n}; } print qq{

Note: If a Java Security window comes up, you need to click "Run"

More options »

}; exit; } $width = ($cgi{'w'} or 725); $height = ($cgi{'h'} or 500); push @commands, "/NS SID $nick $password" if $password; push @commands, '/join #CraterTrades' if $pokemon; #if(ref($cgi{'chan'})) { # my $x = $cgi{'chan'}; if($cgi{'chan'}) { foreach my $c (split(/,/, $cgi{'chan'})) { push @commands, '/join #' . $c; } } #} #else { # push @commands, '/join #' . $cgi{'chan'}; #} $ca = $cgi{'ca'}; $cb = $cgi{'cb'}; $cc = $cgi{'cc'}; $smil = $cgi{'smil'}; $r = int(rand(@hosts)); my $commands; for(my $i=1; $i <= @commands; $i++) { my $v = $commands[$i-1]; $commands .= qq{\n}; } print qq{Content-type: text/html SurrealChat.net } . ($pokemon ? q{} : '') . qq{ $commands }. ($smil ? qq{ } : '' ). qq{ }. ( $ca ? qq{} : ''). ( $cb ? qq{} : ''). ( $cc ? qq{} : ''). qq{ };