#!/usr/bin/perl ######### Begin optional setup ########### # Will be displayed in login screen $yourname = 'BlueChat'; # color of title on login screen $titlecolor = '#800000'; # Rules are shown on login screen. # add or delete as necessary. $rules[0], $rules[1], and so on. $rules[0] = '1. Keep all foul language and sexual content in the Adult Channel.'; $rules[1] = '2. Reservar el lenguaje obsceno o con contenido sexual para el Canal Adulto.'; # Image for background of login screen $backgroundimage = ''; # Background color of login screen $backgroundcolor = 'FFFF66'; # Text color of login screen $textcolor = '#000000'; # link color of login screen $linkcolor = '#0000FF'; # Visited link color of login screen $visitedcolor = '#0000FF'; # Active link color of login screen $activecolor = '#FF0000'; # Any additional things you want added to # the bottom of the login screen. $additional = '

Go Back

'; # $additional .= 'You can add more stuff here.'; # $additional .= 'just uncomment these lines'; ######### End Setup ############# &Parse_Form; if (!$formdata{'cname'}) { if ($backgroundimage ne '') { $backgroundimage = 'background="' . $backgroundimage . '"'; } foreach $rule (@rules) { $TheRules .= $rule . '
'; } &Mime; print < $yourname Chat

$yourname: Welcome/Bienvenido

$TheRules

Enter a name to use while chatting
Elige un nombre para entrar

Color Codes Allowed in name (Códigos de colores permitidos):
`1 `2 `3 `4 `5 `6 `7 `8 `9 `0 `! `\@ `\# `\$ `\%
Example: `1James = James

$additional

Version 2.3

ENDHTML exit; } if ($formdata{'cname'}){ my $cname = $formdata{'cname'}; $cname =~ s/\`\#/`A/g; $cname =~ s/\#//g; $cname =~ s/ /\%20/g; &Mime; print < $yourname Chat <body> <p>This page uses frames, but your browser doesn't support them.</p> </body> MAINHTML exit; } &Mime; print <Error

BlueSparks Chat

There was an error trying to run BlueSparks Chat script.

ERRORHTML exit; # Parses the form sub Parse_Form { if ($ENV{'REQUEST_METHOD'} eq 'GET') { @pairs = split(/&/, $ENV{'QUERY_STRING'}); } elsif ($ENV{'REQUEST_METHOD'} eq 'POST') { read (STDIN, $buffer, $ENV{'CONTENT_LENGTH'}); @pairs = split(/&/, $buffer); if ($ENV{'QUERY_STRING'}) { @getpairs = split(/&/, $ENV{'QUERY_STRING'}); push(@pairs, @getpairs); } } else { &ErrorMessage("Must use Post or Get."); } foreach $pair (@pairs) { ($key, $value) = split(/=/, $pair); $key =~ tr/+/ /; $key =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; $value =~ s///g; if ($formdata{$key}) { $formdata{$key} .= ", $value"; } else { $formdata{$key} = $value; } } } # Standard little error message routine sub ErrorMessage { my $msg = shift; print "Content-type: text/html\n\n$msg"; exit; } # Prints a html file to the screen sub Print_Htm { open(MYFILE, "<$_[0]") || &ErrorMessage("$_[0] not found in html directory"); &Mime; print while ; close(MYFILE); } # Prints the mime header only sub Mime { print "Content-type: text/html\nPragma: no-cache\n\n"; }