#!/usr/bin/perl ######### Begin optional setup ########### ######### Empieza la instalacion opcional ########### #------------------------------------------ # Will be displayed in login screen #------------------------------------------ # Se vera en la pantalla de acceso #------------------------------------------ $yourname = 'PalmeiraVirtual'; #------------------------------------------ # color of title on login screen #------------------------------------------ # color del titulo en la pantalla de acceso #------------------------------------------ $titlecolor = '#3399FF'; #------------------------------------------ # Rules are shown on login screen. # add or delete as necessary. $rules[0], $rules[1], and so on. #------------------------------------------ # Reglas que se muestran en la pantalla de acceso # Añada o elimine lo que sea necesario $rules[0], $rules[1], etc #------------------------------------------ $rules[0] = ' 1. ESTE ES UN CHAT DE PRUEBA DE PALMEIRA VIRTUAL'; $rules[1] = ' 2. POR FAVOR, EVITAR MALOS MODALES'; $rules[2] = ' 3. SE RUEGA EL BUEN COMPORTAMIENTO DEL PERSONAL'; #------------------------------------------ # Image for background of login screen #------------------------------------------ # Imagen para el fondo de la pantalla de acceso #------------------------------------------ $backgroundimage = ''; #------------------------------------------ # Background color of login screen #------------------------------------------ # Color de fondo para la pantalla de acceso #------------------------------------------ $backgroundcolor = '#FFFFFF'; #------------------------------------------ # Text color of login screen #------------------------------------------ # Color del texto en la pantalla de acceso #------------------------------------------ $textcolor = '#000000'; #------------------------------------------ # link color of login screen #------------------------------------------ # Color de los enlaces en la pantalla de acceso #------------------------------------------ $linkcolor = '#0000FF'; #------------------------------------------ # Visited link color of login screen #------------------------------------------ # Color de los enlaces visitados en la pantalla de acceso #------------------------------------------ $visitedcolor = '#0000FF'; #------------------------------------------ # Active link color of login screen #------------------------------------------ # Color de los enlaces activos en la pantalla de acceso #------------------------------------------ $activecolor = '#FF0000'; #------------------------------------------ # Any additional things you want added to # the bottom of the login screen. #------------------------------------------ # Cualquier cosa adicional que desee que # se añada al final de la pagina de acceso #------------------------------------------ $additional = '

Volver a la página anterior

'; # $additional .= 'Puedes añadir lo que desees (en HTML).'; # $additional .= 'simplemente descomente estas lineas o añada lineas $additional.='; #------------------------------------------ # Si desea que desaparezca la pagina de acceso # y se muestre la pagina anterior # una vez que el usuario haya accedido al chat # ponga $atras_si='1' #------------------------------------------ $atras_si='1'; ######### End Setup ############# ######### Fin instalacion ############# &Parse_Form; if (!$formdata{'cname'}) { if ($backgroundimage ne '') { $backgroundimage = 'background="' . $backgroundimage . '"'; } foreach $rule (@rules) { $TheRules .= $rule . '
'; } &Mime; $aniadido=""; if ($atras_si eq '1'){ $aniadido="window.history.back();" } print < $yourname Chat

Bienvenido a $yourname Chat

$TheRules

Introduce tu nombre o nick

Códigos de color permitidos en el nombre o nick:
`1 `2 `3 `4 `5 `6 `7 `8 `9 `0 `! `\@ `\# `\$ `\%
Ejemplo: `1Santi = Santi

$additional

Palmeira Virtual

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>Esta p&aacute;gina usa recuadros y tu navegador no los acepta</p> </body> MAINHTML exit; } &Mime; print <Error

Palmeira Virtual Chat

Se ha producido un error intentando ejecutar el Chat de Palmeira Virtual.

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] no fué encontrado en el directorio html "); &Mime; print while ; close(MYFILE); } # Prints the mime header only sub Mime { print "Content-type: text/html\nPragma: no-cache\n\n"; }