Foro - Perl en Español

por **explorer** » 2024-09-18 01:42 @112

... o casi.

Hace unos años hice algunas pruebas con ChatGPT y el resultado era horrible. En cuanto solicitabas la elaboración de un script medianamente complicado, se empezaba a inventar cosas.

Al año siguiente repetí la prueba y bueno, salían cosas muy interesantes. Tenías que repasar el código, desde luego, pero ya había avanzado mucho. Cierto es que seguía inventándose líneas, bibliotecas y código extraño. Pero se lo decías, te pedía perdón y lo volvía a intentar. Seguro que insistiendo saldría lo pedido.

Hace unos minutos he pedido la realización de un script medianamente complejo. Le he explicado todos los pasos con detalle. Y ChatGPT (el modelo gratuito) me ha generado un script de 100 líneas, de las cuales sólo una "sobra". Sorprendente.

Dejo aquí para la posteridad semejante logro. Después del código pongo algún comentario al respecto.

Sintáxis: [ Descargar ] [ Ocultar ]

Using text Syntax Highlighting

Necesito un script en lenguaje Perl, que analice todos los archivos *.conf del directorio /etc/awffull.

Por cada archivo, lo abrimos y buscamos por una línea que comience por la palabra LogFile.

A continuación de esa palabra (separada de la anterior por uno o más espacios), hay una ruta a un archivo de tipo log. Esa ruta tiene este aspecto: "/var/log/apache2/DOMINIO-access.log.1" siendo DOMINIO lo que va a variar dentro del bucle principal.

Hay que tomar esa ruta, quitarle la última parte ".1".

Entonces, en el directorio /var/log/apache2/ buscamos por todos los archivos cuyo nombre vaya desde DOMINIO-access.log.52.gz hasta DOMINIO-access.log.2.gz (o sea, vamos decrementando desde 52 a 2).

Por cada archivo encontrado, lo abrimos y leemos (necesitaremos una biblioteca para leer archivos gzip).

Sólo nos interesa saber si alguna líneas del archivo contiene el texto "GET /Estadisticas/ ".

Hacemos lo mismo con los archivos DOMINIO-access.log.1 y DOMINIO-access.log

Si en todos estos archivos, no apareció el texto buscado, debemos desactivar el archivo .conf leído antes. Para ello, lo renombramos añadiendo al nombre anterior el sufijo '.off'.

Repetimos para los demás archivos.Coloreado en 0.000 segundos,  usando GeSHi 1.0.8.4

Resultado:

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

#!/usr/bin/perl
use strict;
use warnings;
use File::Grep qw(fgrep);
use IO::Uncompress::Gunzip qw(gunzip $GunzipError);
use File::Copy;
 
# Directorio de configuración y logs
my $conf_dir = "/etc/awffull";
my $log_dir = "/var/log/apache2";
 
# Abrimos el directorio /etc/awffull
opendir(my $dh, $conf_dir) or die "No se puede abrir el directorio $conf_dir: $!";
 
# Recorremos cada archivo *.conf
while (my $conf_file = readdir($dh)) {
    next unless $conf_file =~ /\.conf$/;  # Solo procesamos archivos .conf
 
    my $conf_path = "$conf_dir/$conf_file";
 
    # Abrimos el archivo .conf
    open(my $fh, '<', $conf_path) or die "No se puede abrir $conf_path: $!";
 
    # Buscamos la línea que comienza con "LogFile"
    my $log_file;
    while (my $line = <$fh>) {
        if ($line =~ /^LogFile\s+(.+)$/) {
            $log_file = $1;  # Capturamos la ruta del archivo log
            last;
        }
    }
    close($fh);
 
    # Si no encontramos una línea con "LogFile", pasamos al siguiente archivo
    next unless defined $log_file;
 
    # Quitamos la extensión ".1" al archivo de log
    $log_file =~ s/\.1$//;
 
    # Extraemos el nombre del dominio
    my ($dominio) = $log_file =~ /\/var\/log\/apache2\/(.+)-access\.log/;
 
    # Si no podemos extraer el dominio, pasamos al siguiente archivo
    next unless defined $dominio;
 
    my $found = 0;
 
    # Función para verificar si el archivo contiene "GET /Estadisticas/"
    sub contains_estadisticas {
        my ($file) = @_;
        if ($file =~ /\.gz$/) {
            my $input = IO::Uncompress::Gunzip->new($file) or die "No se puede abrir $file: $GunzipError";
            while (my $line = <$input>) {
                return 1 if $line =~ /GET \/Estadisticas\//;
            }
        } else {
            open(my $log_fh, '<', $file) or die "No se puede abrir $file: $!";
            while (my $line = <$log_fh>) {
                return 1 if $line =~ /GET \/Estadisticas\//;
            }
            close($log_fh);
        }
        return 0;
    }
 
    # Verificamos los archivos DOMINIO-access.log.52.gz a DOMINIO-access.log.2.gz
    for (my $i = 52; $i >= 2; $i--) {
        my $gz_file = "$log_dir/$dominio-access.log.$i.gz";
        if (-e $gz_file) {
            if (contains_estadisticas($gz_file)) {
                $found = 1;
                last;
            }
        }
    }
 
    # Verificamos DOMINIO-access.log.1 y DOMINIO-access.log
    if (!$found && -e "$log_file.1" && contains_estadisticas("$log_file.1")) {
        $found = 1;
    }
 
    if (!$found && -e "$log_file" && contains_estadisticas($log_file)) {
        $found = 1;
    }
 
    # Si no encontramos "GET /Estadisticas/", desactivamos el archivo .conf
    if (!$found) {
        my $new_conf_file = "$conf_file.off";
        rename($conf_path, "$conf_dir/$new_conf_file") or warn "No se puede renombrar $conf_path a $new_conf_file: $!";
        print "Desactivado: $conf_file\n";
    }
}
 
closedir($dh);
 
Coloreado en 0.008 segundos,  usando GeSHi 1.0.8.4

El código es completamente funcional. Sí: funciona y además hace lo que se le pide.

Pero... hay algunas cosillas que comentar.

La línea 4 -use File::Grep qw(fgrep);- sobra. De hecho, este es el único "fallo". Pero es un fallo mínimo. Simplemente, no usa el método 'fgrep' en el resto del programa.
Hay mucho código que se puede simplificar. Por ejemplo, aunque es un acierto crear una subrutina para detectar la presencia de la cadena "GET /Estadisticas/", el procesamiento de los archivos en formato gzip es prácticamente idéntico a la de los archivos no comprimidos, así que en vez de tener un bucle y un par de pruebas más abajo, se puede hacer todo en un único bucle.

Esta es mi versión, que no difiere mucho.

Sintáxis: [ Descargar ] [ Ocultar ]

Using perl Syntax Highlighting

#!/usr/bin/env perl
#
# Desactiva archivos de configuración en el Awffull (generador informes actividad web).
#
# Debido a que los clientes no suelen ver estas estadísticas, lo mejor es desactivarlas
# cuando ha pasado un tiempo prudencial (un año en este código).
# La desactivación se hace agregando '.off' al nombre del archivo de configuración.
#
# [Entrada]
#   Ninguna
#
# [Salida]
#   Ninguna
#
# Joaquín Ferrero, 20240917, basada en la solución propuesta por ChatGPT
# Última versión:  20240917
#
use v5.24.1;
use Path::Tiny;
use IO::Uncompress::Gunzip;
 
### Configuración ###
my $conf_dir = path('/etc/awffull');
my $logs_dir = path('/var/log/apache2');
 
### Procesamiento de los archivos de configuración ###
foreach my $conf_file ($conf_dir->children( qr/\.conf$/ )) {
 
    # Nombre del archivo de registro (log)
    my $log_file;
    for ($conf_file->lines({ count => 50 })) {
        if (/^LogFile\s+(.+?)(\.1)?$/) {
            $log_file = $1;                     # Capturamos la ruta del archivo log
            last;
        }
    }
    next unless defined $log_file;
 
    # Nombres de los archivos a analizar:
    # log_file
    # log_file.1
    # log_file.2.gz
    # ...
    # log_file.52.gz
    my @logs = ((map { "$log_file$_" } "", ".1"), (map { "$log_file.$_.gz" } 2..52));
 
    # Buscar llamada a Estadisticas, en los archivos pasados y presente
    my $encontrado = 0;
 
    for my $log (@logs) {
        next if not -e $log;
 
        # Abrir archivo, comprimido o no
        my $fh = $log =~ /\.gz$/
               ? (IO::Uncompress::Gunzip->new($log) or die "gunzip failed: $!")
               : path($log)->filehandle("<")
               ;
 
        while (<$fh>) {
            if (m{GET /Estadisticas\/? }) {
                $encontrado = 1;                # Se encontró
                last;
            }
        }
 
        close $fh;
 
        last if $encontrado;                    # No es necesario buscar más
    }
 
    if (not $encontrado) {
        say "$conf_file -> $conf_file.off";
        $conf_file->move("$conf_file.off");
    }
}
 
__END__
Coloreado en 0.003 segundos,  usando GeSHi 1.0.8.4

Foro - Perl en Español

La inteligencia artificial ya sabe programar bien en Perl

La inteligencia artificial ya sabe programar bien en Perl

Publicidad

¿Quién está conectado?