el cgi no responde cuando se manda el form
- Código: Seleccionar todo
#!/usr/bin/perl -w
use strict;
use CGI;
use CGI::Cookie;
use IO::Socket;
use CGI::Session;
my $session;
my $cgi = new CGI;
my $url = $cgi->url();
#exit if ($url ne $ENV{'HTTP_REFERER'});
my $conf = {
irc_server => 'irc.redmundial.org',
irc_port => 6668,
irc_nick => 'WeBPerfil',
irc_pass => 'xxxxx',
session_path => '/var/tmp',
session_expire => '+2h',
cookie_path => '/rm',
cookie_domain => '.redmundial.org',
cookie_httponly => 'true'
};
#recoje las cokies del navegador
my %cookies = fetch CGI::Cookie;
#si existe la cookie de session guardamos el sid
my $CGISESSID = $cookies{'CGISESSID'};
#recoje el form
my %FORM = $cgi->Vars;
#recoje una sesion si existe
if ($CGISESSID) {
#recupera una session con el sid de la cookie
$session = new CGI::Session("driver:File", $CGISESSID, {Directory=> $conf->{session_path}});
#si la session existe deveria devolver el nick
my $nick = $session->param('nick');
#sino existe el nick elimina la session
if (!$nick) {
$session->delete();
undef $session;
undef $CGISESSID;
# print "Set-Cookie: CGISESSID=0; expires=22-Nov-1985 00:00:00 GTM; path=/rm; domain=.redmundial.org \n";
}
}
#si estan mandando el form i no ai session
if (!$session and %FORM and !$CGISESSID) {
if (!$FORM{'pass'} or !$FORM{'nick'}) {
print $cgi->header;
print $cgi->start_html;
print <<EOT;
<form name="perfil_login" id="perfil_login" method="post" action="$url">
<p>Identifícate poniendo tu nick y tu contraseña de acceso a la red de IRC. Recuerda que estos datos son los de tu nick registrado en <a href="http://redmundial.org">irC.redmundial.oRg</a></p>
<p>Al ser usuario autentificado tendrás acceso a más funcionalidades del web.</p>
<p>Nick: <input type="text" id="nick"></p>
<p>Contraseña: <input type="password" id="pass"></p>
<p><input type="submit" value="Identificarse"></p>
</form>
<h1>Respuesta de Identificación</h1>
<p>Debes Rellenar Todos los Campos del Formulario</p>
EOT
}
else {
my $html = perfil_login($FORM{'nick'}, $FORM{'pass'});
print $html;
}
}
#se manda el form i ya existe la session
elsif ($session and %FORM and $CGISESSID) {
print $cgi->header;
print $cgi->start_html;
my $nick = $session->param('nick');
print <<EOT;
<h1>Respuesta de Identificación</h1>
<p>Ya estabas Identificado</p>
<p>tu nick es: $nick</p>
<p>tu id de session es: $CGISESSID</p>
EOT
}
#no se manda el form i no ai session
elsif (!$session and !%FORM and !$CGISESSID) {
print $cgi->header;
print $cgi->start_html;
print <<EOT;
<form name="perfil_login" id="perfil_login" method="post" action="$url">
<p>Identifícate poniendo tu nick y tu contraseña de acceso a la red de IRC. Recuerda que estos datos son los de tu nick registrado en <a href="http://redmundial.org">irC.redmundial.oRg</a></p>
<p>Al ser usuario autentificado tendrás acceso a más funcionalidades del web.</p>
<p>Nick: <input type="text" id="nick"></p>
<p>Contraseña: <input type="password" id="pass"></p>
<p><input type="submit" value="Identificarse"></p>
</form>
EOT
}
#si la session existe i es valida
else {
print $cgi->header;
print $cgi->start_html;
my $sid = $session->id();
my $nick = $session->param('nick');
print <<EOT;
<p>Eres un usuario Identificado</p>
<p>tu nick es: $nick</p>
<p>tu id de session es: $CGISESSID</p>
EOT
}
print $cgi->end_html;
exit;
sub perfil_login {
my ($nick, $pass, $return) = (shift, shift, undef);
$nick = lc($nick);
#crea el socket con el irc
my $socket = IO::Socket::INET->new(
Proto => "tcp",
PeerAddr => $conf->{irc_server},
PeerPort => $conf->{irc_port})
or die "No he podido conectar!\n";
$socket->autoflush(1);
#enviamos datos al irc para conectar a la red
print $socket "NICK ".$conf->{irc_nick}."!".$conf->{irc_pass}."\r\n";
print $socket "USER WebPerfiles - - :WeB Perfiles\r\n";
#lectura del socket
while(defined(my $linia=<$socket>)) {
#borra final de linia i retorno de carro del socket
chomp($linia); chomp($linia);
#crea un array con el contenido de cada string que nos envia el irc
my(@recibido) = split(" ", $linia);
#respuest al ping de irc
print $socket "PONG $recibido[1]\r\n" if ($recibido[0] eq "PING");
#cuando recibe la informacion del MOTD le dice al bot nick que le de la pass del nick del formulario
print $socket "PRIVMSG NICK GETPASS $nick\r\n" if ($recibido[1] eq '422');
#procesa la respuesta del bot nick
if ($recibido[0] eq ':[email protected]' and $recibido[1] eq 'PRIVMSG') {
my $realpwd = $recibido[8];
#kita los colores i caracteres no deseados
$realpwd =~ s/\003(\d{1,2})(\,(\d{1,2})|)//g;
$realpwd =~ s/[\x00-\x1f]//g;
$realpwd =~ s/.$//;
#si la pass no es correcta
if ($pass ne $realpwd) {
$return .= $cgi->header;
$return .= $cgi->start_html;
$return .=<<EOT;
<form name="perfil_login" id="perfil_login" method="post" action="$url">
<p>Identifícate poniendo tu nick y tu contraseña de acceso a la red de IRC. Recuerda que estos datos son los de tu nick registrado en <a href="http://redmundial.org">irC.redmundial.oRg</a></p>
<p>Al ser usuario autentificado tendrás acceso a más funcionalidades del web.</p>
<p>Nick: <input type="text" id="nick"></p>
<p>Contraseña: <input type="password" id="pass"></p>
<p><input type="submit" value="Identificarse"></p>
</form>
<h1>Respuesta de Identificación</h1>
<p>La Contraseña que introdujo No coincíde con la del Nick o el Nick que introdujo no está registrado</p>
EOT
#salimos del while
last;
}
#si la pass es correcta creamos una session y luego asignamos una cookie con el sid de la session
if ($pass eq $realpwd) {
$session = new CGI::Session("driver:File", undef, {Directory=> $conf->{session_path}});
my $cookie = $cgi->cookie(
-name=>$session->name,
-value=>$session->id,
-expires=>$conf->{session_expire},
-path=>$conf->{cookie_path},
-domain=>$conf->{cookie_domain},
-httponly=> $conf->{cookie_httponly}
);
$return .= $cgi->header(-cookie => $cookie);
$return .= $cgi->start_html;
$session->expire($conf->{session_expire});
$session->param('nick', $nick);
my $sid = $session->id();
$return .=<<EOT;
<h1>Respuesta de Identificación</h1>
<p>Bienvenido $nick ahora estas identificado.</p>
<p>tu id de session es: $sid</p>
EOT
last;
}
}
}
$socket->close();
return $return;
}
Si alguien sabe pls
Salu2
