#!/usr/bin/perl

# ---------------------------------------------------------------
# Prontus CMS
# http://www.prontus.cl
# by Altavoz.net
#
# licensed under LGPL license.
# http://www.prontus.cl/license.html
# ---------------------------------------------------------------

# -------------------------------COMENTARIO GLOBAL---------------
# ---------------------------------------------------------------
# PROPOSITO.
# -----------
# Implementa rutinas para manejar el envio de data entre el browser  y el server. Emula a la
# libreria standard de Perl CGI.pm
# ---------------------------------------------------------------

# ---------------------------------------------------------------
# DIRECTIVAS DE COMPILACION.
# ---------------------------
package glib_cgi_05;

use strict;
use utf8;

# ---------------------------------------------------------------#
# SUB-RUTINAS.
# ---------------------------------------------------------------#

our %FORM = ();
our %REALPATH = ();
our %MULTIVALUES = ();
our $BUFFER_SIZE = 100000; # Usar minimo 512 bytes, de otra forma no funciona.
our $TEMP_DIR = "";
our $CURRENTFILEIDX = 0; # se reinica por el propio script cuando el numero es muy grande

# --------------------------------------------------------------------#
# Retorna el valor del objeto de formulario pasado por parametro. ej : $FORM{'campo1'} = &glib_cgi_05::param('campo1');
# Si vienen varios valores para el campo especificado, se retorna un array con estos valores. ej : @valores_campo1 = &glib_cgi_05::param('campo1');
# Si se llama sin parametros, devuelve un array con los nombres de todos los campos. ej : @nom_campos = &glib_cgi_05::param();
# Si el control es de tipo file, retorna el path nombre original del archivo. ej: $FORM{'file1'} = &glib_cgi_05::param('file1');
sub param {
    my $control_name = $_[0];
    if ($control_name ne '') {
        if ($MULTIVALUES{$control_name} eq 'S') {
            return split(/\t/, $FORM{$control_name});
        } else {
            return $FORM{$control_name};
        }
    } else {
        return (keys(%FORM));
    }
} # param

# --------------------------------------------------------------------#
sub set_formvar {
    my $control_name = shift;
    my $hash = shift;

    if ($control_name ne '') {
        if ($MULTIVALUES{$control_name} eq 'S') {
            $$hash{$control_name} = split(/\t/, $FORM{$control_name});
        } else {
            $$hash{$control_name} = $FORM{$control_name};
        }
    }
} # param

# --------------------------------------------------------------------#
sub real_paths {
    # devuelve el path real (original) de un archivo subido
    my $control_name = $_[0];

    if ($control_name ne '') {
        return $REALPATH{$control_name};
    }
    return '';
} # real_paths

# --------------------------------------------------------------------#
sub new {
    #reset a las variables de la cgi
    %FORM = ();
    %REALPATH = ();
    %MULTIVALUES = ();
    $TEMP_DIR = "";
    $BUFFER_SIZE = 100000;

    my $script_path = '';
    if (defined($ENV{'SCRIPT_FILENAME'})) {
        $script_path = $ENV{'SCRIPT_FILENAME'};
        $script_path =~ s/\\/\//g; # 4.7
    }
    my $ridx = rindex($script_path,'/');
    if ($ridx < 0) {
        if (defined($ENV{'PATH_TRANSLATED'})) {
            $script_path = $ENV{'PATH_TRANSLATED'};
            $script_path =~ s/\\/\//g;
            $script_path =~ s/\/cgi\-.*//g;
        }
        if (defined($ENV{'SCRIPT_NAME'})) {
            $script_path .= $ENV{'SCRIPT_NAME'};
        }
        $ridx = rindex($script_path,'/');
    }
    my $cgi_dir = substr($script_path, 0, $ridx);
    $TEMP_DIR = "$cgi_dir/prontus_temp";

    if ($CURRENTFILEIDX == 0 && defined($ENV{'CONTENT_LENGTH'})) {
        $CURRENTFILEIDX = $ENV{'CONTENT_LENGTH'} % 1000;
    }

    # Recibe la data enviada enviada y la pone dentro de los hash %FORM e %IMAGENES.
    my ($buffer,$value,$aux,@itm,$head,$con,$nom,$fgn);
    my ($prematch,$buf1,$buf2);
    my ($sep,$itm,$status,$readbytes,$wrotebytes,$filename,$extension,$temp_filename);
    my (@pairs,$data,$findata);

    binmode STDIN;
    &garbage_collector();

    # Determina el metodo a utilizar.
    # Ejemplo: multipart/form-data; boundary=---------------------------7d31d6b2bc
    $aux = $ENV{'CONTENT_TYPE'};

    if ( ($ENV{'REQUEST_METHOD'} ne 'GET') && ($aux =~ /multipart\/form-data/) ) {
        # Se trata de un formulario con submit de archivos.
        # Obtiene string separador.
        $sep = '--' . &getheadvalue($aux,'boundary');

        $aux = '';
        $nom = '';
        $buf1 = '';
        $buf2 = '';
        $temp_filename = '0';
        $findata = 0;
        $readbytes = 0;

        my $OUTFILE;
        do {
            if ($buf1 !~ /$sep.+?\r\n\r\n/s) {
                if ($readbytes < $ENV{'CONTENT_LENGTH'}) { # 4.4
                    # 4.4 Ajusta tamano del buffer a leer.
                    if ( ($ENV{'CONTENT_LENGTH'} - $readbytes) < $BUFFER_SIZE) {
                        $BUFFER_SIZE = $ENV{'CONTENT_LENGTH'} - $readbytes;
                    }
                    $readbytes += read(STDIN, $buf2, $BUFFER_SIZE); # Lee 1 trozo solo si lo necesita.
                } else {
                    $buf2 = '';
                }
                if ($buf2 eq '') {
                    $findata = 1;
                }
            }

            $aux = $buf1 . $buf2;

            # Encontro un separador con encabezado y todo.
            # Se agrega "|$sep.+?" para que considere el último separador en el editor de archivos prontus
            if ($aux =~ /$sep.+?\r\n\r\n|$sep.+?/s) {

                # Redefine buffers para acomodarse al limite recien descubierto.
                $prematch = $`; # Prematch.
                chop $prematch; # 4.1
                chop $prematch; # 4.1
                $head = $&; # Match.
                $buf1 = $'; # Postmatch.
                $buf2 = '';
                $aux = '';

                #~ print STDERR "prematch[$prematch]head[$head]buf1[$buf1]\n"; # debug
                # Finiquita datos anteriores.
                if ($temp_filename eq '0') {
                    if ($nom ne '') {
                        $data .= $prematch;

                        # Artilugio para compatibilidad multivalues.
                        if ( ($FORM{$nom} eq '') || ($filename ne '') ) {
                            &correct_encode_utf8_string($data);
                            $FORM{$nom} = $data;
                        } elsif ( ($data) and ($FORM{$nom} ne $data) and ($FORM{$nom} !~ /\t$data$/) and ($FORM{$nom} !~ /\t$data\t/) and ($FORM{$nom} !~ /^$data\t/)) { # 8.0 ajusta e.r.
                            $MULTIVALUES{$nom} = 'S';
                            &correct_encode_utf8_string($data);
                            $FORM{$nom} .= "\t$data"; # Acumula contenido separado por tabs.
                        }
                        $data = '';
                    }
                } else {
                    print $OUTFILE $prematch;
                    close $OUTFILE;
                    $wrotebytes += length $prematch;
                    if ($wrotebytes == 0) {
                        $FORM{$nom} = '';
                        unlink "$TEMP_DIR/$temp_filename";
                    }
                }

                # Inicializa nueva variable.
                $nom = &getheadvalue($head,'name');
                &correct_encode_utf8_string($nom);
                $filename = &getheadvalue($head,'filename');
                &correct_encode_utf8_string($filename);

                if ($filename =~ /\w/) {
                    $extension = '';
                    $REALPATH{$nom} = $filename; # guarda el path real del archivo por si se desea usar.
                    if ($filename =~ /(\/|\\)([^\/\\]+)$/) { # Elimina el path.
                        $filename = $2;
                    }
                    if ($filename =~ /\.([^.]*)$/) { # Detecta la extension.
                        $extension = '.' . $1;
                    }
                    $temp_filename = &get_file_name($extension) . $extension; # 4.2 Genera nombre temporal.
                    open($OUTFILE, '>', "$TEMP_DIR/$temp_filename");
                    binmode $OUTFILE;
                    $wrotebytes = 0;
                    $data = "$TEMP_DIR/$temp_filename"; # Si se trataba de un archivo, el dato es el nombre del archivo con full path.
                    $FORM{$nom} = $data; # 4.1
                } else {
                    $temp_filename = '0';
                    $data = '';
                }
            } else { # No encuentra aun un separador con encabezado y todo.
                # Acumula datos.
                # print "Acumula datos[$temp_filename][$nom][$buf1][$data]\n"; # debug
                if ($temp_filename eq '0') {
                    if ($nom ne '') {
                        $data .= $buf1;
                    }
                } else {
                    print $OUTFILE $buf1;
                    $wrotebytes += length $buf1;
                    if ($wrotebytes == 0) {
                        $FORM{$nom} = '';
                        close $OUTFILE;
                        unlink "$TEMP_DIR/$temp_filename";
                    }
                }
                $buf1 = $buf2;
                $buf2 = '';
            }
        } until ($findata); # 4.5 La cosa termina cuando no queda data que analizar.

        if (($buf1 ne '') || ($data ne '')) { # 4.1 4.3 Quedan datos por rescatar.
            # Finiquita datos de la variable en curso.
            if ($temp_filename eq '0') {
                if ($nom ne '') {
                    $data .= $buf1;

                    # 4.3 Elimina posible ultimo separador.
                    $data =~ s/\r\n$sep.*$//s; # 4.3
                    # Artilugio para compatibilidad multivalues.
                    if ( ($FORM{$nom} eq '') || ($filename ne '') ) {
                        &correct_encode_utf8_string($data);
                        $FORM{$nom} = $data;
                    } elsif ( ($data) and ($FORM{$nom} ne $data) and ($FORM{$nom} !~ /\t$data$/) and ($FORM{$nom} !~ /\t$data\t/) and ($FORM{$nom} !~ /^$data\t/)) {    # 8.0 ajusta e.r.
                        $MULTIVALUES{$nom} = 'S';
                        &correct_encode_utf8_string($data);
                        $FORM{$nom} .= "\t$data"; # Acumula contenido separado por tabs.
                    }
                    $data = '';
                }
            } else {
                print $OUTFILE $buf1;
                close $OUTFILE;
                $wrotebytes += length $buf1;
            }
        }
    } else {
        if ($ENV{'REQUEST_METHOD'} eq 'GET') {
            $buffer = $ENV{'QUERY_STRING'};
        } else {
            read(STDIN, $buffer, $ENV{'CONTENT_LENGTH'});

            # agrega query string al buffer de entrada para rescatar parametros si vienen
            $buffer = $ENV{'QUERY_STRING'} . '&'.$buffer if ($ENV{'QUERY_STRING'});
        }

        # Se trata de un formulario "normal" (application/x-www-form-urlencoded).
        # print STDERR "buffer [$buffer]\n"; # debug
        @pairs = split(/&/, $buffer);
        foreach my $pair (@pairs) {
            ($nom, $data) = split(/=/, $pair);

            # print STDERR "pair [$pair]\n";
            # Un-Webify plus signs and %-encoding
            $nom =~ tr/+/ /; # ych
            $nom =~ s/%00//sg; # 4.9
            $nom =~ s/%([0-9A-Ha-h]{2})/pack("c",hex($1))/ge; # ych
            $data =~ tr/+/ /;
            $data =~ s/%00//sg; # 4.9
            $data =~ s/%([0-9A-Ha-h]{2})/pack("c",hex($1))/ge;
            &correct_encode_utf8_string($nom);
            &correct_encode_utf8_string($data);

            # Anulacion de subshells.
            $data =~ s/~!/ ~!/g;
            if (($nom ne '') and ($FORM{$nom} eq '')) {  # ych
                $FORM{$nom} = '';
            }

            # Artilugio para compatibilidad multivalues.
            if ($FORM{$nom} eq '') {
                $FORM{$nom} = $data;
            } elsif ( ($FORM{$nom} ne $data) and ($FORM{$nom} !~ /\t$data$/) and ($FORM{$nom} !~ /\t$data\t/) and ($FORM{$nom} !~ /^$data\t/)) {    # 8.0 ajusta e.r.
                $MULTIVALUES{$nom} = 'S';
                $FORM{$nom} .= "\t$data"; # Acumula contenido separado por tabs.
            }

            # print STDERR "$nom = [" . $FORM{$nom} . "]\n"; # debug
        }
    }
} # new

# --------------------------------------------------------------------#
# Retorna el valor del item de un encabezado.
sub getheadvalue {
    my ($header,$item) = @_;
    my (@sub_sep, $sub_nom,$sub_val);
    @sub_sep = split(/(\; |\r\n)/, $header); # Separa header en '; ' y en retornos de carro.
    foreach (@sub_sep) {
        ($sub_nom,$sub_val) = split('=');
        if ($sub_nom eq $item) {
            if ($sub_val =~ /\"([^\"]+)\"/) {    # Elimina las comillas (si las tiene).
                return $1;
            } else {
                return $sub_val;
            }
        }
    }
} # getheadvalue

# --------------------------------------------------------------------#
# 4.0 Inicializa y limpia el directorio temporal, "prontus_temp".
sub garbage_collector {
    my (@entries,@stats);
    if (!(-d $TEMP_DIR)) {
        mkdir $TEMP_DIR, 493;

        # directorio no existia, no necesita garbage
        return;
    }

    # Lee el contenido del directorio.
    if (opendir(DIR, $TEMP_DIR)) {
        @entries = readdir(DIR);
        closedir DIR;
    }

    my $time = time;
    # Borra cualquier archivo con mas de 2 horas de antiguedad.
    foreach my $entry (@entries) {
        if (-f "$TEMP_DIR/$entry") {
            @stats = stat "$TEMP_DIR/$entry";

            # print $stats[10] . ' ';
            if ($stats[10] < ($time - 7200)) { # 2 horas.
                unlink "$TEMP_DIR/$entry";
            }
        }
    }
} # garbage_collector

# --------------------------------------------------------------------#
# Obtiene un nombre de archivo unico.
sub get_file_name {
    my $extension = $_[0];
    $CURRENTFILEIDX++;
    my $string = &random_string($CURRENTFILEIDX%10 + 8);
    # Comprueba si el archivo no existe, si existe, incrementa $CURRENTFILEIDX.
    while (-e "$TEMP_DIR/" . $$ . "$CURRENTFILEIDX$string\.$extension") {
        $CURRENTFILEIDX++;
        if ($CURRENTFILEIDX > 10000) { return 0; }
    }
    return $$ . $CURRENTFILEIDX . $string;
} # get_file_name

# --------------------------------------------------------------------------- #
# Retorna un string aleatorio de n letras.
sub random_string {
    my $n       = $_[0];
    my @charset = ('A', 'B', 'C', 'D', 'E', 'F', 'G', 'H', 'J', 'K', 'L', 'M', 'N', 'P', 'R', 'T', 'U', 'V', 'W', 'X', 'Y', '2', '3', '4', '5', '6', '7', '8', '9', 'a', 'b', 'c', 'd', 'e', 'g', 'h', 'i', 'j', 'k', 'm', 'n', 'o', 'p', 'r', 's', 'u', 'v', 'w', 'x', 'y', 'z' );
    # 51 caracteres
    my $i;
    my $salida = '';
    for ($i = 0 ; $i < $n ; $i++) {
        $salida .= $charset[int(rand(51))];
    }
    # print "$salida\n"; # debug
    return $salida;
}

# --------------------------------------------------------------------------- #
sub correct_encode_utf8_string {
    if (!utf8::is_utf8($_[0])) {
        utf8::decode($_[0]);
    }
}

1;
