Using perl Syntax Highlighting
Así, le quitamos todo aquello que no parezcan números y puntos al final de la cadena.
-
- Publicidad
Redirector para squid
33 mensajes
• Página 2 de 4 • 1, 2, 3, 4
por explorer » 2009-06-09 18:18 @804
Pues no lo entiendo... en fin... una forma de resolverlo sería filtrando $address para asegurarnos de que solo contiene una IP.
Así, le quitamos todo aquello que no parezcan números y puntos al final de la cadena.
Así, le quitamos todo aquello que no parezcan números y puntos al final de la cadena.
JF^D Perl programming & Raku programming. Grupo en Telegram: https://t.me/Perl_ES
-
explorer - Administrador
- Mensajes: 14480
- Registrado: 2005-07-24 18:12 @800
- Ubicación: Valladolid, España
Publicidad
por angelruiz » 2009-06-10 22:22 @973
Les cuento que ya van unos cuantos días conociendo a Perl y me gusta bastante. Hasta ahora con su ayuda he avanzado bastante.
El siguiente script está trabajando al 100%
Las pruebas las realicé con squid 2.7. y cumple con los objetivos.
1.- en el archivo lisip.conf ingreso una lista de IP, a cuyos usuarios quiero hacerles llegar un aviso, el cual se repetirá a los diez minutos de inactividad en navegación.
2- En el archivo BLOCK ingreso una lista de IP (un IP por línea), a cuyos usuarios les sale un aviso permanente (se les bloquea la apertura de páginas, todas las URL son reemplazadas por una página de bloqueo).
3- el archivo listanegra contiene una lista de URL consideradas como prohibidas. Dichas páginas son reemplazadas por otra que indica el mensaje del bloqueo.
Me falta
:
Quiero anexarle otra lista de URL de la siguiente manera:
Archivo block.txt
Con la intención de que si es solicitado el URL http://www.loquesea.com lo redireccione a http://www.perlenespanol.com
De igual forma si es solicitado http://www.norecuerdo.com lo redireccione a http://sirecuerdo.com
Conseguí este code
El siguiente script está trabajando al 100%
Using perl Syntax Highlighting
#!/partition/perl/bin/perl
#
my $TIMEOUT = 3600;
my $URL = "http://192.168.50.1:560";
my $BX = "http://192.168.50.1:559";
$file= "/partition/trabajo/lisip.conf";
open(DATOS, "<$file");
my @lineas = <DATOS>;
chomp @lineas;
close(DATOS);
##############
$bfile= "/partition/trabajo/block";
open(BLOCK, "<$bfile");
my @stopp = <BLOCK>;
chomp @stopp;
close(BLOCK);
#############
$cfile= "/partition/trabajo/listanegra.conf";
open(PROH, "<$cfile");
my @prohi = <PROH>;
chomp @prohi;
close(PROH);
#############
$|=1;
my %registro;
while (<>) {
@X = split;
$url = $X[0];
$address = $X[1];
$ident = $X[2];
$method = $X[3];
################################
foreach $denied (@stopp) {
chomp @stopp;
$st = "$denied/-";
if ("$st" eq "$address") {
$top1 = 1;
} else {
$top2 = 0;
}
}
my $nopas = $top1+$top2;
$n1=0;
################################
foreach $ngr (@prohi) {
chomp @prohi;
$nunc = "$ngr/";
#$n1 = 0;
if ("$nunc" eq "$url") {
$n1 = 1;
} else {
$n2 = 0;
}
}
my $ng = $n1+$n2;
################################
#$pasa1=0;
foreach $linea (@lineas) {
#$pasa1=0;
#$pasa2=0;
chomp @lineas;
$paz = "$linea/-";
if ("$paz" eq "$address") {
$pasa1=1;
} else {
$pasa2=0;
}
}
my $pasa = $pasa1+$pasa2;
my $registrado = 0;
################################
# Redirijo sólo las ips de la lista
if ("$pasa" eq "1") {
# Tenemos $address registrada ?
my @ips = keys %registro;
foreach(@ips) {
if ($_ == $address) {
if ((time - $registro{$address}) >= $TIMEOUT) {delete $registro{$address};
} else {
$registrado = 1;
#print "Tengo la ip registrada !!!";
}
}
}
} else {
$registrado = 1; # Nos saltamos la redirección
}
################################
if ("$nopas" eq "1") {
$registrado = 0;
$URL = "http://192.168.50.1:558"
}
if (! $registrado) {
#$url = $URL;
print "302:$URL\n";
$registro{$address}=time;
}
elsif ("$ng" eq "1") {
print "302:$BX\n";
}
else {
print "$url\n";
}
}
#
my $TIMEOUT = 3600;
my $URL = "http://192.168.50.1:560";
my $BX = "http://192.168.50.1:559";
$file= "/partition/trabajo/lisip.conf";
open(DATOS, "<$file");
my @lineas = <DATOS>;
chomp @lineas;
close(DATOS);
##############
$bfile= "/partition/trabajo/block";
open(BLOCK, "<$bfile");
my @stopp = <BLOCK>;
chomp @stopp;
close(BLOCK);
#############
$cfile= "/partition/trabajo/listanegra.conf";
open(PROH, "<$cfile");
my @prohi = <PROH>;
chomp @prohi;
close(PROH);
#############
$|=1;
my %registro;
while (<>) {
@X = split;
$url = $X[0];
$address = $X[1];
$ident = $X[2];
$method = $X[3];
################################
foreach $denied (@stopp) {
chomp @stopp;
$st = "$denied/-";
if ("$st" eq "$address") {
$top1 = 1;
} else {
$top2 = 0;
}
}
my $nopas = $top1+$top2;
$n1=0;
################################
foreach $ngr (@prohi) {
chomp @prohi;
$nunc = "$ngr/";
#$n1 = 0;
if ("$nunc" eq "$url") {
$n1 = 1;
} else {
$n2 = 0;
}
}
my $ng = $n1+$n2;
################################
#$pasa1=0;
foreach $linea (@lineas) {
#$pasa1=0;
#$pasa2=0;
chomp @lineas;
$paz = "$linea/-";
if ("$paz" eq "$address") {
$pasa1=1;
} else {
$pasa2=0;
}
}
my $pasa = $pasa1+$pasa2;
my $registrado = 0;
################################
# Redirijo sólo las ips de la lista
if ("$pasa" eq "1") {
# Tenemos $address registrada ?
my @ips = keys %registro;
foreach(@ips) {
if ($_ == $address) {
if ((time - $registro{$address}) >= $TIMEOUT) {delete $registro{$address};
} else {
$registrado = 1;
#print "Tengo la ip registrada !!!";
}
}
}
} else {
$registrado = 1; # Nos saltamos la redirección
}
################################
if ("$nopas" eq "1") {
$registrado = 0;
$URL = "http://192.168.50.1:558"
}
if (! $registrado) {
#$url = $URL;
print "302:$URL\n";
$registro{$address}=time;
}
elsif ("$ng" eq "1") {
print "302:$BX\n";
}
else {
print "$url\n";
}
}
Coloreado en 0.004 segundos, usando GeSHi 1.0.8.4
Las pruebas las realicé con squid 2.7. y cumple con los objetivos.
1.- en el archivo lisip.conf ingreso una lista de IP, a cuyos usuarios quiero hacerles llegar un aviso, el cual se repetirá a los diez minutos de inactividad en navegación.
2- En el archivo BLOCK ingreso una lista de IP (un IP por línea), a cuyos usuarios les sale un aviso permanente (se les bloquea la apertura de páginas, todas las URL son reemplazadas por una página de bloqueo).
3- el archivo listanegra contiene una lista de URL consideradas como prohibidas. Dichas páginas son reemplazadas por otra que indica el mensaje del bloqueo.
Me falta
: Quiero anexarle otra lista de URL de la siguiente manera:
Archivo block.txt
- Código: Seleccionar todo
http://www.loquesea.com http://www.perlenspanol.com
http://www.norecuerdo.com http://sirecuerdo.com
ect...
Con la intención de que si es solicitado el URL http://www.loquesea.com lo redireccione a http://www.perlenespanol.com
De igual forma si es solicitado http://www.norecuerdo.com lo redireccione a http://sirecuerdo.com
Conseguí este code
Using perl Syntax Highlighting
#!/partition/perl/bin/perl
$|=1;
while (<>) {
s@http://www.altavista.com@http://192.168.50.1:8281@;
s@http://www.google.co.ve/intl/en_com/images/logo_plain.png@http://www.brazilfw.com.br/users/angelruiz/angel.JPG@;
s@http://www.google.com.ar/intl/en_com/images/logo_plain.png@http://www.brazilfw.com.br/users/angelruiz/angel.JPG@;
s@http://rad.msn.com@http://www.brazilfw.com.br/users/angelruiz/angel.JPG@;
s@http://ads1.msn.com@http://www.brazilfw.com.br/users/angelruiz/angel.JPG@;
s@http://a.rad.msn.com@http://www.brazilfw.com.br/users/angelruiz/angel.JPG@;
s@http://spe.atdmt.com@http://www.brazilfw.com.br/users/angelruiz/angel.JPG@;
print;
}
$|=1;
while (<>) {
s@http://www.altavista.com@http://192.168.50.1:8281@;
s@http://www.google.co.ve/intl/en_com/images/logo_plain.png@http://www.brazilfw.com.br/users/angelruiz/angel.JPG@;
s@http://www.google.com.ar/intl/en_com/images/logo_plain.png@http://www.brazilfw.com.br/users/angelruiz/angel.JPG@;
s@http://rad.msn.com@http://www.brazilfw.com.br/users/angelruiz/angel.JPG@;
s@http://ads1.msn.com@http://www.brazilfw.com.br/users/angelruiz/angel.JPG@;
s@http://a.rad.msn.com@http://www.brazilfw.com.br/users/angelruiz/angel.JPG@;
s@http://spe.atdmt.com@http://www.brazilfw.com.br/users/angelruiz/angel.JPG@;
print;
}
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4
- angelruiz
- Perlero nuevo
- Mensajes: 32
- Registrado: 2009-06-03 08:33 @398
por explorer » 2009-06-11 02:57 @165
Jeje... ¡vaya código!
Cosas repetidas, usar variables como banderas... No pasa nada, porque estás aprendiendo Perl
Y si funciona, pues eso es lo importante.
Sigues teniendo un comparador de igualdad numérica (==) y yo insisto en que eso está mal. Debe ser uno de cadena (eq).
Repites chomp() donde no hace falta.
Habría que revisar el sangrado de líneas, porque es un jaleo poder leerlo tal como está.
En cuanto a lo que te queda por hacer, se puede resolver fácil con un simple diccionario (hash).
Cosas repetidas, usar variables como banderas... No pasa nada, porque estás aprendiendo Perl
Y si funciona, pues eso es lo importante.Sigues teniendo un comparador de igualdad numérica (==) y yo insisto en que eso está mal. Debe ser uno de cadena (eq).
Repites chomp() donde no hace falta.
Habría que revisar el sangrado de líneas, porque es un jaleo poder leerlo tal como está.
En cuanto a lo que te queda por hacer, se puede resolver fácil con un simple diccionario (hash).
JF^D Perl programming & Raku programming. Grupo en Telegram: https://t.me/Perl_ES
-
explorer - Administrador
- Mensajes: 14480
- Registrado: 2005-07-24 18:12 @800
- Ubicación: Valladolid, España
por angelruiz » 2009-06-11 11:16 @511
Veo que estoy alargando mucho el post 
Lo limpié un poco
Lo limpié un poco
Using perl Syntax Highlighting
#!/partition/perl/bin/perl
#
my $TIMEOUT = 3600;
my $URL = "http://192.168.50.1:560";
my $BX = "http://192.168.50.1:559";
$file= "/partition/trabajo/lisip.conf";
open(DATOS, "<$file");
my @lineas = <DATOS>;
chomp @lineas;
close(DATOS);
##############
$bfile= "/partition/trabajo/block";
open(BLOCK, "<$bfile");
my @stopp = <BLOCK>;
chomp @stopp;
close(BLOCK);
#############
$cfile= "/partition/trabajo/listanegra.conf";
open(PROH, "<$cfile");
my @prohi = <PROH>;
chomp @prohi;
close(PROH);
#############
$|=1;
my %registro;
while (<>) {
@X = split;
$url = $X[0];
$address = $X[1];
$ident = $X[2];
$method = $X[3];
################################
foreach $denied (@stopp) {
$st = "$denied/-";
if ("$st" eq "$address") {
$top1 = 1;
} else {
$top2 = 0;
}
}
my $nopas = $top1+$top2;
$n1=0;
################################
foreach $ngr (@prohi) {
$nunc = "$ngr/";
if ("$nunc" eq "$url") {
$n1 = 1;
} else {
$n2 = 0;
}
}
my $ng = $n1+$n2;
################################
foreach $linea (@lineas) {
$paz = "$linea/-";
if ("$paz" eq "$address") {
$pasa1=1;
} else {
$pasa2=0;
}
}
my $pasa = $pasa1+$pasa2;
my $registrado = 0;
################################
if ($nopas eq "1") {
$registrado = 0;
$URL = "http://192.168.50.1:558";
}
elsif ("$pasa" eq "1") {
# Tenemos $address registrada ?
my @ips = keys %registro;
foreach(@ips) {
if ($_ == $address) {
if ((time - $registro{$address}) >= $TIMEOUT) {delete $registro{$address};
} else {
$registrado = 1;
#print "Tengo la ip registrada !!!";
}
}
}
} else {
$registrado = 1; # Nos saltamos la redirección
}
if (! $registrado) {
$url = $URL;
print "302:$url\n";
$registro{$address}=time;
}
elsif ("$ng" eq "1") {
print "302:$BX\n";
}
else {
print "$url\n";
}
}
#
my $TIMEOUT = 3600;
my $URL = "http://192.168.50.1:560";
my $BX = "http://192.168.50.1:559";
$file= "/partition/trabajo/lisip.conf";
open(DATOS, "<$file");
my @lineas = <DATOS>;
chomp @lineas;
close(DATOS);
##############
$bfile= "/partition/trabajo/block";
open(BLOCK, "<$bfile");
my @stopp = <BLOCK>;
chomp @stopp;
close(BLOCK);
#############
$cfile= "/partition/trabajo/listanegra.conf";
open(PROH, "<$cfile");
my @prohi = <PROH>;
chomp @prohi;
close(PROH);
#############
$|=1;
my %registro;
while (<>) {
@X = split;
$url = $X[0];
$address = $X[1];
$ident = $X[2];
$method = $X[3];
################################
foreach $denied (@stopp) {
$st = "$denied/-";
if ("$st" eq "$address") {
$top1 = 1;
} else {
$top2 = 0;
}
}
my $nopas = $top1+$top2;
$n1=0;
################################
foreach $ngr (@prohi) {
$nunc = "$ngr/";
if ("$nunc" eq "$url") {
$n1 = 1;
} else {
$n2 = 0;
}
}
my $ng = $n1+$n2;
################################
foreach $linea (@lineas) {
$paz = "$linea/-";
if ("$paz" eq "$address") {
$pasa1=1;
} else {
$pasa2=0;
}
}
my $pasa = $pasa1+$pasa2;
my $registrado = 0;
################################
if ($nopas eq "1") {
$registrado = 0;
$URL = "http://192.168.50.1:558";
}
elsif ("$pasa" eq "1") {
# Tenemos $address registrada ?
my @ips = keys %registro;
foreach(@ips) {
if ($_ == $address) {
if ((time - $registro{$address}) >= $TIMEOUT) {delete $registro{$address};
} else {
$registrado = 1;
#print "Tengo la ip registrada !!!";
}
}
}
} else {
$registrado = 1; # Nos saltamos la redirección
}
if (! $registrado) {
$url = $URL;
print "302:$url\n";
$registro{$address}=time;
}
elsif ("$ng" eq "1") {
print "302:$BX\n";
}
else {
print "$url\n";
}
}
Coloreado en 0.003 segundos, usando GeSHi 1.0.8.4
- angelruiz
- Perlero nuevo
- Mensajes: 32
- Registrado: 2009-06-03 08:33 @398
por angelruiz » 2009-06-12 14:57 @664
Saludos.
Me gustaría limpiar este post, se me alargó mucho y podría causar confusiones a quien lo lea.
En resumen. El código que fui armando parece una represa con goteras .
Cometí el error de no fijarme a fondo en el código de mi amigo Explorer.
Comencé desde cero. En base al código del amigo Explorer (le agregué unas nuevas líneas para extender los diferentes tipos de redirecciones que quiero.
El nuevo código quedo así:
Cumple al 100% además que es mucho más rápido.
1- tenemos una lista de IP llamada BLOCK, es un archivo que contiene:
los clientes que coinciden con dicha IP siempre serán redireccionados a una página (bloqueados).
2- hay una segunda lista de IP llamada lisip.conf,
los clientes que coinciden con dicha lista serán redireccionados a una página con determinado aviso, a diferencia de que esta redirección es temporal. Después de ser redireccionados una vez el script los libera y deja navegar. El script tiene una variable llamada $TIMEOUT = 3600; que indica que si este usuario contenido en lisip.conf después de la primera redirección dejó de navegar durante 3600 seg. será redirigido nuevamente a la página del aviso (no sé si me expliqué bien).
3. El archivo listanegra.conf, contiene una lista de URL.
a las cuales ningún usuario podrá acceder.
Lo que no logro es agregar la cuarta y última tarea:
Crear un archivo así:
con la intención de que si es solicitada la página de http://www.cantv.net, sea cambiada por http://www.mipagina.com
Si es solicitada http://www.otra.com sea reemplazada por http://www.esta.com.
Saludos.
Me gustaría limpiar este post, se me alargó mucho y podría causar confusiones a quien lo lea.
En resumen. El código que fui armando parece una represa con goteras
.Cometí el error de no fijarme a fondo en el código de mi amigo Explorer.
Comencé desde cero. En base al código del amigo Explorer (le agregué unas nuevas líneas para extender los diferentes tipos de redirecciones que quiero.
El nuevo código quedo así:
Using perl Syntax Highlighting
#!/partition/perl/bin/perl
#
$| = 1; # no caché
my $TIMEOUT = 60;
my $URL = "http://192.168.50.1:560";
my $NO_REDIRECT_PREFIX = qr(10\.250);
my $BX = "http://192.168.50.1:559";
my $PH = "http://192.168.50.1:561";
my %registro; # memoria de las IP vistas
# Acá leo las IP
$file= "/partition/trabajo/lisip.conf";
open(DATOS, "<$file");
my @lineas = <DATOS>;
chomp @lineas;
close(DATOS);
$bfile= "/partition/trabajo/block";
open(BLOCK, "<$bfile");
my @stopp = <BLOCK>;
chomp @stopp;
close(BLOCK);
$cfile= "/partition/trabajo/listanegra.conf";
open(PROH, "<$cfile");
my @prohi = <PROH>;
chomp @prohi;
close(PROH);
while (<>) {
my ($url, $address, $ident, $method) = split;
#print "Petición: $url -> $address -> $ident -> $method\n";
for $denied (@stopp) { # ¿Es una de nuestras @lineas?
$st = "$denied/-";
next if $st ne $address; # No, seguimos buscando
$url = "302:$BX"; # Sí, cambiamos la $url
last; # Y salimos
}
# Sólo redirigimos peticiones que no coinciden con NO_REDIRECT_PREFIX
if ($address !~ /$NO_REDIRECT_PREFIX/) {
# ¿Tenemos $address registrada?
my $registrada = 0; # De momento, no
for my $ip (keys %registro) {
next if $ip ne $address; # Seguir buscando mientras no la encontremos
# Si la encontramos,
$registrada = 1; # En principio, decimos que está registrada
if ((time - $registro{$ip}) >= $TIMEOUT) { # Pero, ¿demasiado tiempo?
delete $registro{$ip}; # Sí, la olvidamos
$registrada = 0; # Y no está registrada
}
last; # Se acabó la búsqueda
}
if (!$registrada) { # No está $registrada
for $linea (@lineas) { # ¿Es una de nuestras @lineas?
$paz = "$linea/-";
next if $paz ne $address; # No, seguimos buscando
$url = "302:$URL"; # Sí, cambiamos la $url
$registro{$address} = time; # La registramos
last; # Y salimos
}
}
}
for $ngr (@prohi) { # ¿Es una de nuestras @prohi?
$nunc = "$ngr/";
next if $nunc ne $url; # No, seguimos buscando
$url = "302:$PH"; # Sí, cambiamos la $url
last; # Y salimos
}
print "$url\n";
}
#
$| = 1; # no caché
my $TIMEOUT = 60;
my $URL = "http://192.168.50.1:560";
my $NO_REDIRECT_PREFIX = qr(10\.250);
my $BX = "http://192.168.50.1:559";
my $PH = "http://192.168.50.1:561";
my %registro; # memoria de las IP vistas
# Acá leo las IP
$file= "/partition/trabajo/lisip.conf";
open(DATOS, "<$file");
my @lineas = <DATOS>;
chomp @lineas;
close(DATOS);
$bfile= "/partition/trabajo/block";
open(BLOCK, "<$bfile");
my @stopp = <BLOCK>;
chomp @stopp;
close(BLOCK);
$cfile= "/partition/trabajo/listanegra.conf";
open(PROH, "<$cfile");
my @prohi = <PROH>;
chomp @prohi;
close(PROH);
while (<>) {
my ($url, $address, $ident, $method) = split;
#print "Petición: $url -> $address -> $ident -> $method\n";
for $denied (@stopp) { # ¿Es una de nuestras @lineas?
$st = "$denied/-";
next if $st ne $address; # No, seguimos buscando
$url = "302:$BX"; # Sí, cambiamos la $url
last; # Y salimos
}
# Sólo redirigimos peticiones que no coinciden con NO_REDIRECT_PREFIX
if ($address !~ /$NO_REDIRECT_PREFIX/) {
# ¿Tenemos $address registrada?
my $registrada = 0; # De momento, no
for my $ip (keys %registro) {
next if $ip ne $address; # Seguir buscando mientras no la encontremos
# Si la encontramos,
$registrada = 1; # En principio, decimos que está registrada
if ((time - $registro{$ip}) >= $TIMEOUT) { # Pero, ¿demasiado tiempo?
delete $registro{$ip}; # Sí, la olvidamos
$registrada = 0; # Y no está registrada
}
last; # Se acabó la búsqueda
}
if (!$registrada) { # No está $registrada
for $linea (@lineas) { # ¿Es una de nuestras @lineas?
$paz = "$linea/-";
next if $paz ne $address; # No, seguimos buscando
$url = "302:$URL"; # Sí, cambiamos la $url
$registro{$address} = time; # La registramos
last; # Y salimos
}
}
}
for $ngr (@prohi) { # ¿Es una de nuestras @prohi?
$nunc = "$ngr/";
next if $nunc ne $url; # No, seguimos buscando
$url = "302:$PH"; # Sí, cambiamos la $url
last; # Y salimos
}
print "$url\n";
}
Coloreado en 0.004 segundos, usando GeSHi 1.0.8.4
Cumple al 100% además que es mucho más rápido.
1- tenemos una lista de IP llamada BLOCK, es un archivo que contiene:
- Código: Seleccionar todo
192.168.10.3
192.168.10.5
192.168.10.6
los clientes que coinciden con dicha IP siempre serán redireccionados a una página (bloqueados).
2- hay una segunda lista de IP llamada lisip.conf,
- Código: Seleccionar todo
192.168.10.4
192.168.10.33
los clientes que coinciden con dicha lista serán redireccionados a una página con determinado aviso, a diferencia de que esta redirección es temporal. Después de ser redireccionados una vez el script los libera y deja navegar. El script tiene una variable llamada $TIMEOUT = 3600; que indica que si este usuario contenido en lisip.conf después de la primera redirección dejó de navegar durante 3600 seg. será redirigido nuevamente a la página del aviso (no sé si me expliqué bien).
3. El archivo listanegra.conf, contiene una lista de URL.
- Código: Seleccionar todo
http://www.redtube.com
http://www.petardas.com
a las cuales ningún usuario podrá acceder.
Lo que no logro es agregar la cuarta y última tarea:
Crear un archivo así:
- Código: Seleccionar todo
http://www.cantv.net http://www.mipagina.com
http://www.otra.com http://www.esta.com
con la intención de que si es solicitada la página de http://www.cantv.net, sea cambiada por http://www.mipagina.com
Si es solicitada http://www.otra.com sea reemplazada por http://www.esta.com.
Saludos.
- angelruiz
- Perlero nuevo
- Mensajes: 32
- Registrado: 2009-06-03 08:33 @398
por explorer » 2009-06-14 11:30 @521
Esta solución -de una de las muchas- no la he probado.
Una explicación rápida de algunas partes del programa:
Observar que el último caso se ha simplificado mucho, porque decir que si la IP es la primera vez que se conecta, es lo mismo que decir que lleva más de $tiempo_de_aviso conectada. Por eso, en el momento de la inicialización, les ponemos a un valor que es (time()-$tiempo_de_aviso). Si una IP a controlar se conecta en ese momento, o uno posterior, la condición de la línea 92 siempre se cumplirá.
Este ejercicio es muy bueno porque muestra cómo el uso de diccionarios acelera mucho el programa, porque nos ahorra usar bucles for() para encontrar los valores que queremos. Simplemente, los diccionarios nos dicen si tal o cual elemento es conocido o no. Y además, podemos usar sus valores para guardar información relevante para el programa.
Using perl Syntax Highlighting
- #!/usr/bin/perl
- use strict;
- use warnings;
- use diagnostics;
- use File::Slurp qw( slurp );
- #### Configuración ##########################################################
- my $tiempo_de_aviso = 3_600; # Tiempo máximo de no navegación, para mostrar avisos
- my $URL_BLOQUEADAS = 'http://192.168.50.1:559'; # A donde van a parar las bloqueadas
- my $URL_AVISO = 'http://192.168.50.1:560'; # Aviso a presentar a las controladas
- my $URL_NEGRAS = "http://192.168.50.1:561"; # A donde van a parar las URL de la lista negra
- my $NO_REDIRECT_PREFIX = qr(^10\.250); # No redigirir si es local
- #### Fin configuración ######################################################
- ## Constantes
- $| = 1; # no caché, por exigencias del protocolo
- ## Variables
- my $url; # URL a devolver a SQUID
- my %hay_que_bloquear; # IP a bloquear
- my %hay_que_controlar; # IP a controlar con un aviso
- my %esta_en_lista_negra; # URL en lista negra
- my %hay_que_redireccionar; # URL a redireccionar
- #### Programa ###############################################################
- ## Direcciones IP a bloquear
- %hay_que_bloquear = map {
- $_ => 1
- }
- split $/, slurp 'bloqueadas.txt';
- ## Direcciones IP a controlar
- my $inicio = time - $tiempo_de_aviso;
- %hay_que_controlar = map {
- $_ => $inicio
- }
- split $/, slurp 'controladas.txt';
- ## URL en lista negra
- %esta_en_lista_negra = map {
- $_ . '/' => 1 # Suponemos que las URL NO tienen la '/' final, así que se las ponemos
- }
- split $/, slurp 'lista_negra.txt';
- ## URL a redireccionar
- %hay_que_redireccionar = map {
- my ($c,$v) = split; # Cada línea tiene dos columnas: la URL que buscamos y la nueva URL
- $c . '/' => $v # Suponemos que las URL NO tienen la '/' final, así que se las ponemos
- }
- split $/, slurp 'redireccionadas.txt';
- use Data::Dumper;
- print Dumper \%hay_que_bloquear;
- print Dumper \%hay_que_controlar;
- print Dumper \%esta_en_lista_negra;
- print Dumper \%hay_que_redireccionar;
- ## Bucle principal
- while (<>) {
- ($url, my $ip_fqdn) = split;
- my ($ip, undef) = split '/', $ip_fqdn;
- ## Filtrado si es local
- next if $ip =~ $NO_REDIRECT_PREFIX;
- ## Filtrado si está bloqueda
- if ($hay_que_bloquear{$ip}) {
- $url = "302:$URL_BLOQUEADAS";
- next;
- }
- ## Filtrado si está en la lista negra
- if ($esta_en_lista_negra{$url}) {
- $url = "302:$URL_NEGRAS";
- next;
- }
- ## Filtrado si hay que redireccionar
- if ($hay_que_redireccionar{$url}) {
- $url = $hay_que_redireccionar{$url};
- next;
- }
- ## Filtrado si hay que controlar
- if ($hay_que_controlar{$ip}) { # ¿Hay que controlar esta IP?
- # Sí
- if (time - $hay_que_controlar{$ip} >= $tiempo_de_aviso) { # ¿Ha pasado mucho tiempo sin navegar?
- $url = "302:$URL_AVISO"; # Sí, redirigimos
- }
- $hay_que_controlar{$ip} = time; # Recordamos última vez que la hemos visto
- }
- }
- continue {
- print "$url\n";
- }
- #### Fin ####################################################################
- __END__
Coloreado en 0.004 segundos, usando GeSHi 1.0.8.4
Una explicación rápida de algunas partes del programa:
- Línea 6: utilizaremos el módulo File::Slurp para simplificar la lectura de los ficheros
- Líneas 30 a 54: leemos cada fichero con la función slurp(), que separaremos en líneas (el comando split() con el valor $/ como separador tiene la misma función que chomp()). Luego, cada línea se convierte en un elemento de diccionario. Los valores de cada llave tendrán una misión distinta
- Líneas 56 a 60: sacamos las estructuras de datos para comprobar lo leído. Estas líneas son opcionales y hay que comentarlas en el entorno de producción. Su salida será algo como esto:
- Código: Seleccionar todo
$VAR1 = {
'192.168.10.6' => 1,
'192.168.10.3' => 1,
'192.168.10.5' => 1
};
$VAR1 = {
'192.168.10.33' => 1244983191,
'192.168.10.4' => 1244983191
};
$VAR1 = {
'http://www.redtube.com/' => 1,
'http://www.petardas.com/' => 1
};
$VAR1 = {
'http://www.cantv.net/' => 'http://www.mipagina.com',
'http://www.otra.com/' => 'http://www.esta.com'
};
Del grupo de IP bloqueadas y de URL en lista negra solo nos interesa saber de su existencia, por lo que sus valores son siempre '1'. Del grupo de IP a controlar, su valor será el momento (time()) del último acceso. Y del grupo de URL a redirigir, el valor será el nuevo URL. Observar que a los dos grupos de URL se le han añadido '/' al final, pues suponemos que en los ficheros no los tienen - Línea 65: por cada línea que entra, solo nos quedamos con los dos primeros valores: el URL y el par IP/FQDN (atendiendo al formato indicado en la página de SQUID: Feature: Redirection Helpers)
- Línea 66: extraemos la IP, el otro dato que nos interesaba
- Línea 69: hacemos el filtrado principal: si la IP es local, terminamos enseguida
- Línea 72: si la $ip es de las que %hay_que_bloquear, cambiamos la $url
- Línea 78: si la $url es de las que %esta_en_lista_negra, cambiamos la $url
- Línea 84: si la $url %hay_que_redireccionar, cambiamos la $url a la que deseamos cambiar
- Línea 90: si la $ip es de las que %hay_que_controlar, para mandarles un aviso,
- Línea 92: miramos a ver si ha pasado el $tiempo_de_aviso,
- Línea 93: si es así, cambiamos la $url
- Línea 96: actualizamos a la hora actual, para controlar cuánto tiempo lleva navegando
- Líneas 99 a 101: en cada vuelta del while(), al final, siempre devolveremos la $url al SQUID
Observar que el último caso se ha simplificado mucho, porque decir que si la IP es la primera vez que se conecta, es lo mismo que decir que lleva más de $tiempo_de_aviso conectada. Por eso, en el momento de la inicialización, les ponemos a un valor que es (time()-$tiempo_de_aviso). Si una IP a controlar se conecta en ese momento, o uno posterior, la condición de la línea 92 siempre se cumplirá.
Este ejercicio es muy bueno porque muestra cómo el uso de diccionarios acelera mucho el programa, porque nos ahorra usar bucles for() para encontrar los valores que queremos. Simplemente, los diccionarios nos dicen si tal o cual elemento es conocido o no. Y además, podemos usar sus valores para guardar información relevante para el programa.
JF^D Perl programming & Raku programming. Grupo en Telegram: https://t.me/Perl_ES
-
explorer - Administrador
- Mensajes: 14480
- Registrado: 2005-07-24 18:12 @800
- Ubicación: Valladolid, España
por angelruiz » 2009-06-14 13:30 @604
Amigo Explorer es de admirar y reconocer su esfuerzo por colaborar y enseñar. Admirable en todos los sentidos, se requiere de trabajo tiempo y esa voluntad desinteresada de colaboración. Gracias.
Esta noche probaré y te comento los resultados.
Una pregunta algo tonta:
¿'bloqueadas.txt' es allí donde debo colocar '/partition/trabajo/bloqueadas.txt'?
Esta noche probaré y te comento los resultados.
Una pregunta algo tonta:
¿'bloqueadas.txt' es allí donde debo colocar '/partition/trabajo/bloqueadas.txt'?
- angelruiz
- Perlero nuevo
- Mensajes: 32
- Registrado: 2009-06-03 08:33 @398
por explorer » 2009-06-14 13:53 @620
Sí, es el nombre del fichero. Lo puedes cambiar por el camino completo al fichero, claro.
JF^D Perl programming & Raku programming. Grupo en Telegram: https://t.me/Perl_ES
-
explorer - Administrador
- Mensajes: 14480
- Registrado: 2005-07-24 18:12 @800
- Ubicación: Valladolid, España
por angelruiz » 2009-06-17 11:30 @521
Hola amigo.
El script funciona perfectamente.
Me costo instalar el módulo File::Slurp (lo instalé manualmente y quedó al 100%)
Una pregunta sobre esta variable:
¿Esos 3_600 son segundos? ¿El porqué del '_' ? Curiosidad.
Le creé un archivo de variables y otro script con reglas iptables para controlar el tráfico por puertos diferentes al 80 para los usuarios bloqueados. Además un cgi en bash para el entorno webadmin de brazailfw. Donde se editan las variables y las páginas de avisos.
Cuando esté listo posteo los scripts y demás.
Saludos.
El script funciona perfectamente.
Me costo instalar el módulo File::Slurp (lo instalé manualmente y quedó al 100%)
Una pregunta sobre esta variable:
Using perl Syntax Highlighting
¿Esos 3_600 son segundos? ¿El porqué del '_' ? Curiosidad.
Le creé un archivo de variables y otro script con reglas iptables para controlar el tráfico por puertos diferentes al 80 para los usuarios bloqueados. Además un cgi en bash para el entorno webadmin de brazailfw. Donde se editan las variables y las páginas de avisos.
Cuando esté listo posteo los scripts y demás.
Saludos.
- angelruiz
- Perlero nuevo
- Mensajes: 32
- Registrado: 2009-06-03 08:33 @398
33 mensajes
• Página 2 de 4 • 1, 2, 3, 4
¿Quién está conectado?
Usuarios navegando por este Foro: No hay usuarios registrados visitando el Foro y 3 invitados