Foro - Perl en Español

La comunidad de programadores en Perl de habla hispana.

Obviar


  • Publicidad

Mostrar país del visitante

¿Apenas comienzas con Perl? En este foro podrás encontrar y hacer preguntas básicas de Perl con respuestas aptas a tu nivel.
Publicar una respuesta

Mostrar país del visitante

Notapor globalworkteam » 2013-01-06 21:20 @930

Hola,

Quisiera saber si hay algun script para mostrar el país del visitante, en Perl.

Un saludo y Gracias.
globalworkteam
Perlero nuevo
Perlero nuevo
 
Mensajes: 14
Registrado: 2012-04-17 20:26 @893
Arriba

Publicidad

Re: Mostrar país del visitante

Notapor explorer » 2013-01-06 21:29 @937

En CPAN hay algunos módulos que sirven para saber información del usuario en función de la IP que está utilizando en ese momento.

De los que salen por ahí, veo que el más moderno puede ser Geo::IP2Location. Antes tienes que bajarte la base de datos con las IP, como te indica en la página de manual.
JF^D Perl programming & Raku programming. Grupo en Telegram: https://t.me/Perl_ES
Avatar de Usuario
explorer
Administrador
Administrador
 
Mensajes: 14480
Registrado: 2005-07-24 18:12 @800
Ubicación: Valladolid, España
Arriba

Re: Mostrar país del visitante

Notapor globalworkteam » 2013-01-07 01:09 @089

Hola.

Tengo un script, en el cual tengo que rellenar un formulario con una IP y éste me da los datos de esa IP, como el código del país, el país...

Lo que me gustaría hacer es que sin necesidad de rellenar el formulario me dé esos valores leyendo la IP con $ENV{'REMOTE_ADDR'};

El script es el siguiente:

Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. #!/usr/bin/perl
  2. #-------------------------------------------------------------------------------
  3. # CHANGE TOP LINE TO SUITE PATH TO PERL ON YOUR SERVER
  4. #-------------------------------------------------------------------------------
  5. ###############################################################################
  6. # WORKS ON LINUX SERVERS. NOT TESTED ON WINDOZE!!!
  7. ###############################################################################
  8. # copyright 2005 by B Maurer.  All rights reserved.
  9. # This program is free software; you can redistribute it and/or modify it
  10. # under the same terms as Perl itself.
  11. #
  12. # INDEMNITY:
  13. #
  14. # THIS SOFTWARE IS PROVIDED WITHOUT ANY WARRANTY WHATSOEVER. USE ENTIRELY AT YOUR
  15. # OWN RISK. NO LIABILITY WHATSOEVER, OF ANY NATURE, WILL BE ASSUMED BY
  16. # THE AUTHORS. SHOULD THE SOFTWARE DAMAGE YOUR SERVER, CAUSE YOU LOSS OR OTHER
  17. # FINANCIAL DAMAGE, YOU AGREE YOU HAVE NO CLAIM. IF YOU DO NOT ACCEPT THESE
  18. # TERMS YOU MAY NOT USE THIS SOFTWARE.
  19. ###############################################################################
  20. # WEBSITE: http://webnet77.com
  21. # DOWNLOAD: http://webnet77.com/scripts/index.html
  22. ###############################################################################
  23. use strict;
  24. use CGI qw(:standard);
  25. #-------------------------------------------------------------------------------
  26. # Change the lines below to suite your application
  27. #-------------------------------------------------------------------------------
  28. my $geofile        = 'IpToCountry.csv';
  29. my $date_delimiter = '-';
  30. my $date_format    = 'mmm-dd-yyyy';
  31. #-------------------------------------------------------------------------------
  32. #             NO MORE USER DEFINABLE PARAMATERS AFTER THIS LINE
  33. #-------------------------------------------------------------------------------
  34. my ($form, $IP, $CC);
  35. #-------------------------------------------------------------------------------
  36. sub init(){
  37. $form = qq|
  38. <html>
  39.  
  40. <head>
  41. <meta http-equiv="Content-Language" content="en-us" />
  42. <meta http-equiv="Content-Type" content="text/html; charset=windows-1252" />
  43. <title>New Page 1</title>
  44. </head>
  45. <body>
  46. <form method="POST">
  47.         <p>Enter IP Address <input type="text" name="IP" size="20" value="$IP" />
  48.         <input type="submit" value="Submit" name="submit" /></p>
  49. </form>
  50. <form method="POST">
  51.         <p>Enter Country Code <input type="text" name="CC" size="2" value="$CC"><input type="submit" value="Submit" name="submit"></p>
  52. </form>
  53. </body>
  54. </html>
  55. |;
  56.   print "Content-type: text/html\n\n";
  57.   $IP = param('IP');
  58.   $CC = param('CC');
  59.  
  60. }
  61. #-------------------------------------------------------------------------------
  62. sub comify($){
  63.  
  64.    my $text = reverse $_[0];
  65.    $text =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1,/g;
  66.    return scalar reverse $text;
  67. }
  68. #-------------------------------------------------------------------------------
  69. sub epoch_to_dd_mm_yyyy($){
  70.  
  71.         my (undef, undef, undef, $dd, $mm, $yyyy, undef, undef, undef) = localtime(shift);
  72.         my $r;
  73.         my %m = (
  74.               '01'=>'Jan',
  75.               '02'=>'Feb',
  76.               '03'=>'Mar',
  77.               '04'=>'Apr',
  78.               '05'=>'May',
  79.               '06'=>'Jun',
  80.               '07'=>'Jul',
  81.               '08'=>'Aug',
  82.               '09'=>'Sep',
  83.               '10'=>'Oct',
  84.               '11'=>'Nov',
  85.               '12'=>'Dec',
  86.               );
  87.  
  88.         $yyyy += 1900;
  89.         $mm++;
  90.  
  91.         $dd = sprintf('%02d', $dd);
  92.         $mm = sprintf('%02d', $mm);
  93.  
  94.         my $mnth = $mm;
  95.  
  96.         if ($date_format eq 'dd-mmm-yyyy'){ $r = "$dd$date_delimiter$m{$mm}$date_delimiter$yyyy"; }
  97.         if ($date_format eq 'mmm-dd-yyyy'){ $r = "$m{$mm}$date_delimiter$dd$date_delimiter$yyyy"; }
  98.         if ($date_format eq 'yyyy-mmm-dd'){ $r = "$yyyy$date_delimiter$m{$mm}$date_delimiter$dd"; }
  99.         if ($date_format eq 'yyyy-dd-mmm'){ $r = "$yyyy$date_delimiter$dd$date_delimiter$m{$mm}"; }
  100.  
  101.         if ($date_format eq 'dd-mm-yyyy'){ $r = "$dd$date_delimiter$mnth$date_delimiter$yyyy"; }
  102.         if ($date_format eq 'mm-dd-yyyy'){ $r = "$mnth$date_delimiter$dd$date_delimiter$yyyy"; }
  103.         if ($date_format eq 'yyyy-mm-dd'){ $r = "$yyyy$date_delimiter$mnth$date_delimiter$dd"; }
  104.         if ($date_format eq 'yyyy-dd-mm'){ $r = "$yyyy$date_delimiter$dd$date_delimiter$mnth"; }
  105.  
  106.         return $r;
  107. }
  108. #------------------------------------------------------------------------------
  109. sub number_to_ip($){ # Number => IP
  110. my $ip = shift;
  111. my (@octets,$i);
  112.  
  113.   $ip =~ /\n/g;
  114.   for($i = 3; $i >= 0; $i--) {
  115.     $octets[$i] = ($ip & 0xFF);
  116.     $ip >>= 8;
  117.   }
  118.   return join('.', @octets);
  119. }
  120. #-------------------------------------------------------------------------------
  121. sub ip_to_number($){ # IP => Number
  122. my $ip = shift;
  123. my (@octets, $ip_num);
  124.  
  125.     $ip =~ s/\n//g;
  126.         @octets = split /\./, $ip;
  127.         $ip_num = 0;
  128.         foreach (@octets) {
  129.             $ip_num <<= 8;
  130.             $ip_num |= $_;
  131.         }
  132. return $ip_num;
  133. }
  134. #-------------------------------------------------------------------------------
  135. sub ip_find($){
  136.   my $ip = ip_to_number($_[0]);
  137.   my ($start, $end, $found);
  138.   my ($CC, $CTRY, $COUNTRY, $ALLOCATED, $REGISTRY, $NETBLOCK, $NUM_IP,
  139.      $NUMERIC, $OCT, $HEX);
  140.  
  141.   $found = 0;
  142.   open GF, "<$geofile";
  143.   while (<GF>){
  144.     next if ! /^"/;
  145.     s/\n|"//g;
  146.     ($start, $end, $REGISTRY, $ALLOCATED, $CC, $CTRY, $COUNTRY) = split /,/, $_;
  147.     if (($ip >= $start) and ($ip <= $end)){
  148.       $found = 1;
  149.       $ALLOCATED = epoch_to_dd_mm_yyyy($ALLOCATED);
  150.       $NETBLOCK = number_to_ip($start) . ' - ' . number_to_ip($end);
  151.       $NUM_IP = comify($end - $start + 1);
  152.       $NUMERIC = comify($start) . ' - ' . comify($end);
  153.       $OCT = sprintf ('%o', $start) . ' - ' . sprintf ('%o', $end);
  154.       $HEX = uc(sprintf ('%x', $start) . ' - ' . sprintf ('%x', $end));
  155.       last;
  156.     }
  157.   }
  158.   close GF;
  159.   print "$IP not found\n" if ! $found;
  160.   print qq|
  161.             <html>
  162.             <head>
  163.             </head>
  164.             <body>
  165.             <div align="center">
  166.                 <table border="0" cellpadding="3" style="border-collapse: collapse">
  167.                     <tbody>
  168.                     <tr>
  169.                         <td>IP Address</td>
  170.                         <td>$IP</td>
  171.                     </tr>
  172.                     <tr>
  173.                         <td>Country Code</td>
  174.                         <td>$CC</td>
  175.                     </tr>
  176.                     <tr>
  177.                         <td>Country </td>
  178.                         <td>$CTRY</td>
  179.                     </tr>
  180.                     <tr>
  181.                         <td>Country </td>
  182.                         <td>$COUNTRY</td>
  183.                     </tr>
  184.                     <tr>
  185.                         <td>Allocated</td>
  186.                         <td>$ALLOCATED</td>
  187.                     </tr>
  188.                     <tr>
  189.                         <td>Registry</td>
  190.                         <td>$REGISTRY</td>
  191.                     </tr>
  192.                     <tr>
  193.                         <td>Net block</td>
  194.                         <td>$NETBLOCK</td>
  195.                     </tr>
  196.                     <tr>
  197.                         <td>HEXADECIMAL</td>
  198.                         <td>$HEX</td>
  199.                     </tr>
  200.                         <tr>
  201.                         <td>OCTAL</td>
  202.                         <td>$OCT</td>
  203.                     </tr>
  204.                     <tr>
  205.                         <td>Numeric</td>
  206.                         <td>$NUMERIC</td>
  207.                     </tr>
  208.                         <td>Hosts in block</td>
  209.                         <td>$NUM_IP</td>
  210.                     </tr>
  211.                 </tbody>
  212.                 </table>
  213.             </div>
  214.             </body></html>
  215.   | if $found;
  216. }
  217. #-------------------------------------------------------------------------------
  218. sub display_cc(){
  219.  
  220.   #my $ip = ip_to_number($CC);
  221.   my ($start, $end, $found);
  222.   my ($cc, $CTRY, $COUNTRY, $ALLOCATED, $REGISTRY, $NETBLOCK, $NUM_IP,
  223.      $NUMERIC, $OCT, $HEX);
  224.  
  225.  
  226.   open GF, "<$geofile";
  227.   print "<html><head></head><body><pre>\n";
  228.   print "<h1>[$CC]</h1>";
  229.   while (<GF>){
  230.     next if ! /^"/;
  231.     s/\n|"//g;
  232.     ($start, $end, $REGISTRY, $ALLOCATED, $cc, $CTRY, $COUNTRY) = split /,/, $_;
  233.     if ($cc eq uc($CC)){
  234.      print sprintf('%-13s', number_to_ip($start)) . " - " . sprintf('%-15s', number_to_ip($end)) . ' [' . comify($end - $start) . " IP's]\n";
  235.     }
  236.   }
  237.   close GF;
  238.   print "</pre></body>";
  239. }
  240. #-------------------------------------------------------------------------------
  241.   init();
  242.   if (! $IP){
  243.     if (! $CC){
  244.       print $form;
  245.     }
  246.     else {
  247.       display_cc();
  248.     }
  249.   }
  250.  
  251.   else {
  252.     if ($IP !~ /\b([01]?\d\d?|2[0-4]\d|25[0-5])\.([01]?\d\d?|2[0-4]\d|25[0-5])\.([01]?\d\d?|2[0-4]\d|25[0-5])\.([01]?\d\d?|2[0-4]\d|25[0-5])\b/){
  253.       print "$IP is not valid\n";
  254.       exit;
  255.     }
  256.     ip_find($IP);
  257.   }
  258.  
Coloreado en 0.009 segundos, usando GeSHi 1.0.8.4
globalworkteam
Perlero nuevo
Perlero nuevo
 
Mensajes: 14
Registrado: 2012-04-17 20:26 @893
Arriba

Re: Mostrar país del visitante

Notapor explorer » 2013-01-07 09:45 @448

Supongo que será modificando la línea 57, ¿no?
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1.   $IP = $ENV{'REMOTE_ADDR'};
Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4
JF^D Perl programming & Raku programming. Grupo en Telegram: https://t.me/Perl_ES
Avatar de Usuario
explorer
Administrador
Administrador
 
Mensajes: 14480
Registrado: 2005-07-24 18:12 @800
Ubicación: Valladolid, España
Arriba

Re: Mostrar país del visitante

Notapor globalworkteam » 2013-01-07 10:13 @467

Me refiero a que el script muestre directamente los datos detectando la IP, sin rellenar antes el formulario.

Gracias
globalworkteam
Perlero nuevo
Perlero nuevo
 
Mensajes: 14
Registrado: 2012-04-17 20:26 @893
Arriba

Re: Mostrar país del visitante

Notapor explorer » 2013-01-07 10:34 @482

Pues eso:

Este programa es un cgi (estamos suponiendo que lo quieres ejecutar como cgi y no desde la línea de comandos).
Entonces, al cgi se le pasan una serie de parámetros, algunos de ellos a través del entorno (%ENV). La variable $ENV{REMOTE_ADDR} guardará la IP desde donde se conecta.
El programa comienza en la línea 241, donde inicializamos el valor de $IP al de $ENV{REMOTE_ADDR}.
En la línea 242 se pregunta si $IP tiene algún valor.
Como así es, salta a la 252, donde se comprueba con una expresión regular si es un IP de verdad.
Como sí lo es, salta a la 256, donde se llama a la función ip_find() (línea 135).
Allí, lo primero que hace es transformar la cuádrupla de números de la IP en un único número entero (línea 136).
Luego, en la 142, abre el archivo de la base de datos (IpToCountry.csv) donde están relacionadas las IP con los países.
Si encuentra el rango al que pertenece la IP que le hemos pasado (línea 147), inicializa una serie de variables (líneas 149 a 154) y las saca en un formulario (líneas 160 a 215).
JF^D Perl programming & Raku programming. Grupo en Telegram: https://t.me/Perl_ES
Avatar de Usuario
explorer
Administrador
Administrador
 
Mensajes: 14480
Registrado: 2005-07-24 18:12 @800
Ubicación: Valladolid, España
Arriba

Re: Mostrar país del visitante

Notapor globalworkteam » 2013-01-07 16:00 @708

Muchas gracias.

Una última pregunta.

¿¿Podría introducir estas variables en otra página??

Es decir, si a este script le llamo por ejemplo "ip.cgi", ¿podría hacer una llamada desde otro cgi con "do 'ip.cgi';" y que en este script pudiera incluir las variables $CC, $CTRY, $COUNTRY, $ALLOCATED, $REGISTRY, $NETBLOCK, $NUM_IP, $NUMERIC, $OCT, $HEX?

Gracias.
globalworkteam
Perlero nuevo
Perlero nuevo
 
Mensajes: 14
Registrado: 2012-04-17 20:26 @893
Arriba

Re: Mostrar país del visitante

Notapor explorer » 2013-01-07 17:57 @789

Hay varias soluciones...

  • Meter el código de ip.cgi dentro del cgi que realmente se va a utilizar. Esta es la mejor solución, desde luego. Y la más sencilla: recuerda que la IP viene desde una variable de entorno. Si ejecutas un segundo código, se puede perder
  • Modifica ip.cgi para que, en lugar de emitir un código HTML con los valores encontrados, que emita esos mismos valores pero en un formato que le sea sencillo leer al cgi principal. Por ejemplo, podríamos emitir cada parámetro en un línea de texto distinta, y luego, en el principal, hacer un
    Sintáxis: [ Descargar ] [ Ocultar ]
    Using perl Syntax Highlighting
    my($CC, $CTRY, $COUNTRY, $ALLOCATED, $REGISTRY, $NETBLOCK, $NUM_IP, $NUMERIC, $OCT, $HEX) = qx(ip.cgi $ENV{REMOTE_ADDR});
    Coloreado en 0.001 segundos, usando GeSHi 1.0.8.4
  • Puedes hacer también un do 'ip.cgi', desde luego, y en ese momento las variable globales de ip.cgi serán conocidas en el cgi principal. Repito: globales. En la línea 138 fíjate que el programa las declara locales con un my(), así que debes cambiar bastante el código

El código, reducido, sería así:
Sintáxis: [ Descargar ] [ Ocultar ]
Using perl Syntax Highlighting
  1. #!/usr/bin/perl
  2. use v5.14;
  3.  
  4. #-------------------------------------------------------------------------------
  5. # Devuelve información sobre la IP pasada sobre argumento
  6. #-------------------------------------------------------------------------------
  7. my $geofile        = 'IpToCountry.csv';
  8. my $date_format    = 'mmm-dd-yyyy';
  9. my $date_delimiter = '-';
  10. #-------------------------------------------------------------------------------
  11.  
  12. my $IP = shift;
  13.  
  14. if ($IP !~ /\b([01]?\d\d?|2[0-4]\d|25[0-5])\.([01]?\d\d?|2[0-4]\d|25[0-5])\.([01]?\d\d?|2[0-4]\d|25[0-5])\.([01]?\d\d?|2[0-4]\d|25[0-5])\b/) {
  15.     say "$IP no es válido";
  16.     exit;
  17. }
  18.  
  19. my $IP_numero = ip_a_numero($IP);
  20.  
  21. my($start, $end);
  22. my($CC, $CTRY, $COUNTRY, $ALLOCATED, $REGISTRY, $NETBLOCK, $NUM_IP, $NUMERIC, $OCT, $HEX);
  23.  
  24. open my $GF, '<', $geofile;
  25. while (<$GF>){
  26.     next if ! /^"/;
  27.     s/\n|"//g;
  28.  
  29.     ($start, $end, $REGISTRY, $ALLOCATED, $CC, $CTRY, $COUNTRY) = split /,/;
  30.  
  31.     if ($IP_numero >= $start  and  $IP_numero <= $end) {
  32.         $ALLOCATED = epoch_to_dd_mm_yyyy($ALLOCATED);
  33.         $NETBLOCK  = numero_a_ip($start) . ' - ' . numero_a_ip($end);
  34.         $NUM_IP    = comify($end - $start + 1);
  35.         $NUMERIC   = comify($start) . ' - ' . comify($end);
  36.         $OCT       = sprintf('%o', $start) . ' - ' . sprintf('%o', $end);
  37.         $HEX       = uc(sprintf('%x', $start) . ' - ' . sprintf('%x', $end));
  38.         last;
  39.     }
  40. }
  41. close $GF;
  42.  
  43. say "$IP no encontrada" if not $CC;
  44.  
  45. say join "\n", $CC, $CTRY, $COUNTRY, $ALLOCATED, $REGISTRY, $NETBLOCK, $NUM_IP, $NUMERIC, $OCT, $HEX;
  46.  
  47. sub ip_a_numero($) { # IP => Number
  48.     my $ip = shift;
  49.     my (@octets, $ip_num);
  50.  
  51.     $ip =~ s/\n//g;
  52.     @octets = split /\./, $ip;
  53.     $ip_num = 0;
  54.     foreach (@octets) {
  55.         $ip_num <<= 8;
  56.         $ip_num |= $_;
  57.     }
  58.     return $ip_num;
  59. }
  60.  
  61. sub numero_a_ip($) { # Number => IP
  62.     my $ip = shift;
  63.     my (@octets,$i);
  64.  
  65.     $ip =~ /\n/g;
  66.     for($i = 3; $i >= 0; $i--) {
  67.         $octets[$i] = ($ip & 0xFF);
  68.         $ip >>= 8;
  69.     }
  70.     return join('.', @octets);
  71. }
  72.  
  73. sub comify($) {
  74.    my $text = reverse $_[0];
  75.    $text =~ s/(\d\d\d)(?=\d)(?!\d*\.)/$1 /g;
  76.    return scalar reverse $text;
  77. }
  78.  
  79. sub epoch_to_dd_mm_yyyy($) {
  80.     my ($dd, $mm, $yyyy) = (localtime(shift))[3,4,5];
  81.     my @meses = qw( Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec );
  82.  
  83.     return join $date_delimiter, sprintf('%02d', $dd), $meses[$mm], (1900 + $yyyy);
  84. }
Coloreado en 0.003 segundos, usando GeSHi 1.0.8.4

Entonces, la diferencia entre usar qx() y do() es vital para cambiar o no la línea 45.
JF^D Perl programming & Raku programming. Grupo en Telegram: https://t.me/Perl_ES
Avatar de Usuario
explorer
Administrador
Administrador
 
Mensajes: 14480
Registrado: 2005-07-24 18:12 @800
Ubicación: Valladolid, España
Arriba
Publicar una respuesta

Volver a Básico

¿Quién está conectado?

Usuarios navegando por este Foro: No hay usuarios registrados visitando el Foro y 25 invitados

Powered by phpBB® Forum Software © phpBB Group
Traducción al Español Mexicano por nextgen en colaboración con phpbb-es.com
phpBB SEO
Advertisements by Advertisement Management