#!/usr/bin/perl ######### Begin optional setup ########### # Will be displayed in login screen $yourname = 'AAK'; # 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] = 'Geben Sie einen Chat-Namen ein, dieser wird allen Teilnehmern angezeigt.'; #$rules[1] = 'Ein Passwort ist nicht notwendig.'; # Image for background of login screen $backgroundimage = ''; # Background color of login screen $backgroundcolor = '#FFFFFF'; # 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

Willkommen im AAK Chat

$TheRules

Geben Sie hier Ihren Chat-Namen ein.
Diesen können Sie selbst wählen, ein Passwort ist nicht nötig.

$additional

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"; }