[perl] CGI's
Bolo Lacertus
lacertus@servidor.unam.mx
Fri, 10 Mar 2000 18:26:04 -0600
Saludos!!!
Concuerdo en que es bueno estar de regreso, espero que en el
involuntario retiro que hemos tenido hayamos madurado en nuestras
habilidades :)
"A. Galindo" wrote:
> ¡Que bueno que también está esta lista al aire de nuevo!
> La pregunta del día de hoy:
> ¿Que tanta importancia le dan a el código HTML final que se ve en el
> navegador al programar un CGI?
Ok, como toda respuesta, la mia esta condicionada al ambiente de trabajo
en que estoy, donde el código que hoy escribo espero que alguien mas lo
mantenga mañana.
- El código HTML que se presenta es vital, no solo porque es la imagen
que se da al usuario, sino porque es elaborado por personal de diseño
que sabe la diferencia entre un rojo sangre y un rojo quemado y mas aún,
saben porque preferir uno sobre el otro.
De hecho, esto nos ha llevado a una política algo curiosa, que incluimos
el mínimo código HTML en los CGI's que sea posible (porque nuestro
personal de diseño no suele ser programador de Perl del mismo modo en
que yo no hago diseño). De hecho, aún si es una misma persona la que
hace todo es mas facil aislar el HTML en archivos externos al CGI de
modo que hasta lo puedes editar con la herramienta de tu preferencia
(desde Composer hasta cualquiera otra).
> Por otro lado, ¿alguien tiene por ahí algún fuente o referencias de
> programas hechos con DBI.pm y CGI.pm? estoy haciendo unos cgi's y
> quisiera darme una idea.
Una cosa lleva a la otra, dejame ver que CGI's son ilustrativos...
Lo primero es el como introducir el HTML que necesitas crear vez tras
vez en la página estática que tinenes por ahi en calidad de simple
archivo.
Ok, las expresiones regulares ayudan mucho.
Digamos que tienes una página de demostración "/demo.html":
<HTML><HEAD><TITLE>Pagina de demo</TITLE></HEAD>
<BODY>
Esta es la demostración, aparece cualquier cosa...<br>
<!--cualquiercosa-->
Y eso es todo.<br>
</BODY></HTML>
Por supuesto, poner los enters donde deben de ir es la diferencia entre
poder revisar el HTML que resulta ú obtener solo una larga cadena
completamente inmanejable.
Mas adelante, nuestro CGI, al momento de generar la respuesta:
-------Ok, todo lo que hubo que hacer antes----
open(AE,"/demo.html");
while(<AE>){$resultado.=$_};
close(AE);
#Con esto cargamos el archivo a un solo escalar.
#Supongamos que el HTML a insertar esta en una variable $caso
$resultado=~s/<\!--cualquiercosa-->/$caso/g;
print $resultado;
----------- Voila!-----------------
Ok, se que esto no es lo mas veloz del mundo, pero es tremendamente
cómodo tanto para programar como para editar los HTML (y los diseñadores
gráficos te adoran porque pueden hacer todos los cambios que quieran sin
que te enfades porque tienes que cambiar tus CGI's, de hecho, hasta los
puedes dejar modificar directamente las páginas del sistema si les
avisas que deben respetar tus comentarios HTML).
Pasando a códigos "reales" en los que se emplearon tanto estas técnicas
como otras tantas que ya son práctica común para nosotros:
Salida, un CGI que uso para terminar una sesión (reflajada en una
galleta) de un sistema grande.
#!/usr/bin/perl
# Programa terminador de sesiones 1.0
# Daniel Sol Llaven
# 25 de Mayo de 1997
# PUMA SI
#Librerias
use CGI;
use rutinas;
use DBI;
# Variables de configuración
#Mi propio URL para autoreferencia
$mi_url="http://triton.dgsca.unam.mx/cgi-bin/pumasi/salir.cgi";
# Base de los CGI de pumasi para limitar galleta
$baseCGI="/cgi-bin/pumasi";
#URL para el CGI de entrada
$URLentrada="http://triton.dgsca.unam.mx/cgi-bin/pumasi/entrada.cgi";
#Localizacion del HTMLP para ir a la entrada:
$htmlpentrada="/usr/users/pumasi/docs/entrada.htmlp";
#Correo electronico de la administracion
$emailadmin="pumasi\@triton.dgsca.unam.mx";
#Manejador de base de datos de DBI
$dbi='dbi:mSQL:';
#Base de datos a usar
$bd='PUMASI';
$accion='salida';
$c='s';
#Inicializacion del CGI
$def=new CGI;
#Conneccion a base de datos
$dbh=DBI->connect($dbi.$bd,'pumasi')||error(5);
#Verificar que se presente una galleta de sesion valida
$idses=$def->cookie('pumasises');
if(!(%permisos=verses($dbh,$idses,$accion,$c)))
{
#sesion reprobada por verses o fallo en la verificacion, remitir a
entrada.
print $def->redirect($URLentrada);
#Notese que en caso de cambio de URL se debe editar el .htmlp
open(AE,"<$htmlpentrada") || error 0;
while(<AE>)
{
#s/<!-- Opcional -->/$idses<br>$c1<br>/; #error explicado
print;
}
close AE;
}
else
{
#sesion valida, terminarla y avisar.
if(finses($dbh,$idses))
{
#sesion terminada, remitir a entrada.
print $def->redirect($URLentrada);
#Notese que en caso de cambio de URL se debe editar el .htmlp
open(AE,"<$htmlpentrada") || error 0;
while(<AE>)
{
#s/<!-- Opcional -->/$idses<br>$c1<br>/; #error explicado
print;
}
close AE;
}
else
{
#no se termino con exito la sesion
error(1,"No se pudo terminar la sesion");
}
}
Este ya es parte de un sistema formal por lo que sigue un par de
nuestras reglas adicionales, particularmente, se identifica antes que
nada (quien lo hizo, para que lo hizo y cuando lo hizo) lo que es
indispensable para saber que onda con un programa.
Usa varias librerías entre las que se encuentra una con las funciones
usadas ampliamente en el sistema en su conjunto.
A continuación tiene todas las variables con valores suceptibles de
cambiar en caso de que el sistema tenga que migrarse a otro sistema o
sistema de archivos.
Notarás que emplea un mecanismo para verificar la "galleta de sesión"
que en el caso de este sistema era requisito para que se dejara
utilizar, la rutina que la verifica es parte de las rutinas.pm.
Es mas, una selección de rutinas.pm:
# Libreria de rutinas (Digest) Ver. 3.0
# Daniel Sol Llaven
# 16 de Marzo de 1999
# PUMA SI
sub error
{
$error=shift @_;
#print $def->start_html(-title=>"Error $error");
print "Content-type: text/html\n\n";
print "<HTML><HEAD><TITLE>Error $error</TITLE></HEAD><BODY>\n";
if(!$error)
{
print "<H1>No se ha podido desplegar el archivo</H1>";
}
if($mensaje=shift @_)
{
print "$mensaje\n<br>";
}
print $def->end_html;
exit;
#Intencionalmente criptico, pues no deben generarse errores
}
sub verses($$$$)
{
#Funcion que verifica la validez de una sesion para permitir una
accion
#De nuevo aqui, triggers serian muy buenos para verificar que las
acciones
#reales tengan entradas en al tabla de acciones.
# Recive cuatro parametros, El handle a la base de datos, la sesion,
el
# material sobre el que se operara y la accion a realizar.
# La funcion regresa negativos para error y el arreglo de permisos con
exito.
# Para mantener compatibilidad con el modo anterior, si se le solicita
un
# escalar regresa 1 si la sesion es aceptada.
# -1 error interno a la funcion -2 error en BD -3 incoherencia con BD
# -4 caducidad -5 multiples IP
my($dbh,$idses,$idmat,$accion)=@_;
my($com,$seg,$min,$hor,$dia,$mes,$a,$c1,$res,$fecha,$hora);
my @fs,@fd,@fa,@hs,@hd,@ha;
@fd=(0,0,0); #dias, meses y a~os de duracion
@hd=(2,0,0); #horas minutos y segundos de duracion
if($idses eq "")
{
#Error no se pueden aceptar sesiones nulas.
return wantarray ? () : -1;
}
$com=$dbh->prepare("
select sesion.idses, autoriza.idprmso,
sesion.iniciofe, sesion.inicioho , sesion.ipcli
from sesion,autoriza where
sesion.idusr=autoriza.idusr and
sesion.idses=\'$idses\' and sesion.finfe=NULL")
||return wantarray ? () : -1;
$com->execute || return -2;
$res=$com->fetchrow_arrayref;
#Fecha y hora de creacion de la sesion
$fecha=$res->[2];
$hora=$res->[3];
if($res->[0] ne $idses)
{
#Error la sesion es rechazada por la Base de Datos
return wantarray ? () : -3;
}
#Construccion de hash de permisos
do
{
$permisos{$res->[1]}=1;
} while($res=$com->fetchrow_arrayref);
#Verificacion de coherencia de origen en la sesion
$ipcli=$ENV{'REMOTE_ADDR'}; #Obten la IP del cliente
$ipcli=~/(\d+\.\d+\.\d+\.\d+)/;
$ipcli=$1; #limpieza de IP
$res->[4]=~/(\d+\.\d+\.\d+\.\d+)/;
$res->[4]=$1; #limpieza de IP
if($ipcli ne $res->[4])
{
#La misma galleta de sesion se esta usando en dos IP distintas, esto
es
#un posible ataque por lo que se rechaza la galleta y se cierra la
sesion
#finses($dbh,$idses);
return wantarray ? () : -5;
}
#Hora actual del sistema
($ha[2],$ha[1],$ha[0],$fa[0],$fa[1],$fa[2],$c1,$c1,$c1)=localtime;
#Verificacion de caducidad de la sesion
if((@fs=rfecha($fecha))&&(@fh=rhora($hora)))
{
#comparaciones para ver si sigue vigente. iniciamos con el
año
if(($fs[2]+$fd[2])<$fa[2])
{
finses($dbh,$idses);
return wantarray ? () : -4; #sesion caduca
}
elsif(($fs[2]+$fd[2])==$fa[2])
{
#verificar si sigue en rango el mes
if(($fs[1]+$fd[1])<$fa[1])
{
finses($dbh,$idses);
return wantarray ? () : -4; #sesion caduca
}
elsif(($fs[1]+$fd[1])==$fa[1])
{
#verificar el dia
if(($fs[0]+$fd[0])<$fa[0])
{
finses($dbh,$idses);
return wantarray ? () : -4; #sesion caduca
}
elsif(($fs[0]+$fd[0])==$fa[0])
{
#verificar la hora
if(($hs[0]+$hd[0])<$ha[0])
{
finses($dbh,$idses);
return wantarray ? () : -4; #sesion caduca
}
elsif(($hs[1]+$hd[1])==$ha[1])
{
#verificar el minuto
if(($hs[0]+$hd[0])<$ha[0])
{
finses($dbh,$idses);
return wantarray ? () : -4; #sesion caduca
}
elsif(($hs[2]+$hd[2])==$ha[2])
{
#son identicas, rechazar
finses($dbh,$idses);
return wantarray ? () : -4; #sesion caduca
}
}
}
}
}
#se acepta la sesion como vigente
}
else
{
#El registro no contenia hora y fecha valida de inicio, es un error
anomalo
#pero solo rechazamos la sesion
finses($dbh,$idses);
return wantarray ? () : -4; #sesion caduca
}
#En este punto ya tenemos verificada la sesion como activa
$fecha=fecha($fa[0],$fa[1],$fa[2]);
$hora=hora($ha[0],$ha[1],$ha[2]);
#creacion de la accion
$com=$dbh->prepare("insert into accion values
(\'$idses\',\'$idmat\',\'$accion\',\'$fecha\',\'$hora\')")
||return wantarray ? () : -4;
$com->execute || return wantarray ? () : -1;
#En contexto escalar regresa el numero de permisos (compatibilidad)
return wantarray ? %permisos : (0+%permisos);
}
sub finses
{
#rutina que coloca fecha de terminacion de una sesion, terminandola.
#recive solo el identificador de la sesion y el habdle de base de
datos
my($dbh,$idses)=@_;
my $com,$fecha,$hora,@ha,@fa;
#Hora actual del sistema
($ha[2],$ha[1],$ha[0],$fa[0],$fa[1],$fa[2],$c1,$c1,$c1)=localtime;
$fecha=fecha($fa[0],$fa[1],$fa[2]);
$hora=hora($ha[0],$ha[1],$ha[2]);
#Termina la sesion
$com=$dbh->prepare(
"update sesion set finfe=\'$fecha\',finho=\'$hora\' where
idses=\'$idses\'"
) || return; #error de sintaxis
$com->execute || return; #error de ejecucion
return 1; #regresamos verdadero si la sesion se termina con exito
}
Bueno, ya esta demaciado largo el correito, espero que no te hayan
parecido demaciado descabelladas las recomendaciones. :)
Desenpolvandome: Daniel Sol
--
Bolo Lacertus: lacertus@servidor.dgsca.unam.mx ==~\___\
http://proteo.dgsca.unam.mx/cgi-bin/lacertus/hola =__vvvv
--------- Pie de mensaje --------------------------------
Visite: http://tlali.iztacala.unam.mx/~randrade/perl.shtml
Cancelar inscripcion:
mail to: majordomo@tlali.iztacala.unam.mx
text : unsubscribe perl