climbo

#!/usr/bin/perl -T

##################################################################
# enviaform.cgi     PROCESAMIENTO DE FORMULARIOS
#
# (c) Ivan Nieto Perez
# Este CGI puede descargarse de El Codigo:
# http://www.elcodigo.com
#
# Puede usarse libremente y modificarse siempre que se conserve
# esta cabecera intacta
#
##################################################################

############## SPECIAL FORM VARIABLES ############################
# asunto        Asunto del mensaje de correo. Si no se indica, quedar� en blanco.
# remitente     Direccion de correo del remitente (campo from). Si no se indica, se usa $DIRECCION_FROM.
# obligatorios      Lista de campos obligatorios, separados por comas. Si no se indica, ninguno es obligatorio.
# enviables     [OBLIGATORIO] Lista (y orden) de los campos a enviar en el mensaje de correo, separados por comas.
# url_exito     URL a la que redirigir si exito en el envio. Si no se indica, se muestra pagina por defecto.
# formato_fecha     Formato para la fecha. Si no se indica, formato 2
#           1 >> Jueves, 2 de Enero de 2000, a las 20:30:12
#           2 >> 2 de Enero de 2000, a las 20:30:12
#           3 >> 02/01/2000 - 20:30:12
# responder     A 1 se enviara un mensaje de agradecimiento a la direccion remitente. Si no se especifica, a 0.
##################################################################

use Socket;

#####################################################################
# CONFIGURACION

# Direcciones de correo de los destinatarios (campo to), separadas por comas sin espacios en blanco
$DIRECCIONES_TO = 'formulario@mi_dominio.com';

# Direccion del remitente (campo from) a usar cuando no existe campo remitente en el formulario
$DIRECCION_FROM = 'webmaster@mi_dominio.com';

# Ruta y nombre del fichero con el texto del mensaje de respuesta (si el campo responder del formulario vale 1)
$RESPUESTA = 'respuesta.txt';

# Dominios desde los que puede ejecutarse el CGI separados por comas sin espacios en blanco
$DOMINIOS_VALIDOS = 'elcodigo.net,elcodigo.com';

# Indica si se desea crear fichero de log de accesos: a 1, crea log
$LOG_ACCESOS = 0;

# Ruta y nombre del fichero de log de accesos (a usar solo si $LOG_ACCESOS = 1)
$FICHERO_LOG = 'log_accesos.txt';

# Ruta y nombre de sendmail (el valor de ejemplo es el mas habitual, dejar asi si no se sabe cual es)
$PROGRAMA_SENDMAIL = '/usr/sbin/sendmail -t';

# FIN CONFIGURACION
#####################################################################

#####################################################################
# DEFINICIONES
# Tipos de error
@TipoError = (
      "Error abriendo fichero para lectura.",
      "Error abriendo fichero para escritura.",
      "Este CGI no puede ser invocado directamente en la barra de direcciones del navegador.",
      "Faltan par�metros en la llamada al CGI.",
      "Algunos campos obligatorios no han sido cumplimentados. Pulse RETROCEDER para volver a intentarlo.",
      "Este CGI no puede ejecutarse desde este dominio o pagina.",
      "Hay caracteres no permitidos en alguno de los parametros enviados al CGI.",
      "La direccion de correo electronico introducida no es valida. Pulse RETROCEDER para volver a intentarlo.",
      "Error en el envio del mensaje."
);

$LOCK_EX = 2;
$LOCK_UN = 8;

#lista de destinatarios
@lista_destinatarios = split(/,/, $DIRECCIONES_TO);

# A 1 si se desea que escriba en un fichero en vez de enviar un mensaje (para correccion errores)
$debug = 0;
$MAIL_FILE = 'mail.txt';

#####################################################################

#MAIN

#guarda datos de cada acceso en el log si necesario
&guarda_log if ( $LOG_ACCESOS == 1);

#recibe los datos del formulario via POST y los decodifica
&obtiene_datos_formulario;

#comprueba si el dominio es valido para ejecutar el script
&comprueba_dominio;

#valida los datos obtenidos del formulario
&valida_datos_formulario;

#obtiene la fecha actual
$fecha_actual = &obtiene_fecha( $CAMPOS{'formato_fecha'} );

#escribe o envia los datos del formulario
&construye_mensaje;

#respuesta confirmacion al usuario que envia los datos
&envia_respuesta;

#pagina HTML a mostrar tras el envio del formulario
if ( $CAMPOS{'url_exito'} ne '' ){
    print "Location: $CAMPOS{'url_exito'}\n\n";
} else {
    &pagina_despues_envio;
}

exit;


##################################################################
sub construye_mensaje {

    my $mensaje = '';
    $mensaje .= "El $fecha_actual,\n";
    $mensaje .= "desde la direcci�n IP $ENV{'REMOTE_ADDR'}\n";
    $mensaje .= "ha sido enviada la siguiente informaci�n:\n";

    foreach $campo_a_mostrar (@lista_enviables) {
        $mensaje .= "$campo_a_mostrar = $CAMPOS{$campo_a_mostrar}\n";
    }

    foreach $email (@lista_destinatarios) {
        #invoca la funcion de envio
        &envia_mensaje( $CAMPOS{'asunto'}, $CAMPOS{'remitente'}, $email, '', '', $mensaje);
    }
}

##################################################################
sub obtiene_datos_formulario {

    my $temp = '';
    my $a, $b;

    #lee estandar imput
    read(STDIN, $temp, $ENV{'CONTENT_LENGTH'});

    for (split(/\&/, $temp)) {
        next if (!$_);
        tr/+/ /;
        s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg;
        s/\r//g;
        $b =~ s/<!--(.|\n)*-->//g;
        ($a, $b) = split(/=/);
        $CAMPOS{$a} = $b;
    }

}

##################################################################
sub valida_datos_formulario {

    # obtiene la lista de campos a enviar
    if ( $CAMPOS{'enviables'} ne '' ) {
        $CAMPOS{'enviables'} =~ s/(\s+|\n)?,(\s+|\n)?/,/g;
        $CAMPOS{'enviables'} =~ s/(\s+)?\n+(\s+)?//g;
        if ( $CAMPOS{'enviables'} =~ /[^a-zA-Z0-9_\-\,]+/ ) { &muestra_error(7, 'enviables'); }
        @lista_enviables = split(/,/, $CAMPOS{'enviables'});
    } else {
        # unico campo obligatorio para el CGI
        &muestra_error(4);
    }

    # validacion de los campos obligatorios definidos por el usuario
    if ( $CAMPOS{'obligatorios'} ne '' ) {
        $CAMPOS{'obligatorios'} =~ s/(\s+|\n)?,(\s+|\n)?/,/g;
        $CAMPOS{'obligatorios'} =~ s/(\s+)?\n+(\s+)?//g;
        if ( $CAMPOS{'obligatorios'} =~ /[^a-zA-Z0-9_\-\,]+/ ) { &muestra_error(7, 'obligatorios'); }
        @lista_obligatorios = split(/,/,$CAMPOS{'obligatorios'});
        #comprueba lista de campos requeridos
        foreach $campo_obligatorio (@lista_obligatorios) {
            if ( $CAMPOS{$campo_obligatorio} eq '' ) {
                &muestra_error(5, $campo_obligatorio );
            }
        }
    }

    # formato por defecto para la fecha, si no especificado: 2 de Enero de 2000, a las 20:30:12
    if ( $CAMPOS{'formato_fecha'} eq '' ) {
        $CAMPOS{'formato_fecha'} = '2';
    } else {
        if ( $CAMPOS{'formato_fecha'} =~ /[^0-9]+/ ) { &muestra_error(7, 'formato_fecha'); }
    }

    # si no se especifica el campo responder, no se responde
    if ( $CAMPOS{'responder'} eq '' ) {
        $CAMPOS{'responder'} = 0;
    } else {
        if ( $CAMPOS{'responder'} =~ /[^0-9]+/ ) { &muestra_error(7, 'responder'); }
    }

    # si no existe remitente, se asigna por defecto, y no se envia respuesta
    if ($CAMPOS{'remitente'} eq '') {
        $CAMPOS{'remitente'} = $DIRECCION_FROM;
        $CAMPOS{'responder'} = 0;
    } else {
        &muestra_error(8) if (&valida_email == 0);
    }

    if ( $CAMPOS{'url_exito'} ne '' ) {
        if ( $CAMPOS{'url_exito'} =~ /[^a-zA-Z0-9_\-\:\/\.]+/ ) { &muestra_error(7, 'url_exito'); }
    }

    if ( $CAMPOS{'asunto'} ne '' ) {
        if ( $CAMPOS{'asunto'} =~ /[^a-zA-Z0-9_\-\:\/\.\!\?\$\#\%\@\|\&\/\(\)\=\,\*\+\;\'\"\s\[\]]+/ ) { &muestra_error(7, 'asunto'); }
    }
}

##################################################################
sub pagina_despues_envio {

    print "Content-type: text/html\n\n";
    print <<__W2__;
<html>
<head>
<title>Gracias por cumplimentar nuestro formulario</title>
</head>
<body>
<h1>�Gracias!</h1>
<p>Su informaci�n ha sido enviada con �xito.</p>
<p>Esta es la informaci�n enviada:</p>
<p>
__W2__

    foreach $itm (@lista_enviables) {
    print <<__W2A__;
$itm: $CAMPOS{$itm}
<br>
__W2A__
    }

}


##################################################################
sub envia_respuesta  {

    #solo envia mensaje de agradecimiento si el campo responder vale 1 y existe campo remitente
    if ( ($CAMPOS{'remitente'} ne '') && ($CAMPOS{'responder'} eq '1') ) {

        my $asunto = 'Gracias por cumplimentar nuestro formulario';
        my $mensaje_respuesta = '';
        if ( ($RESPUESTA ne '') && ( open (AM,"< $RESPUESTA") ) ) {
            while (<AM>) {
                chop $_;
                $mensaje_respuesta .= "$_\n";
            }
            close(AM);
        } else {
                $mensaje_respuesta = "Gracias por cumplimentar nuestro formulario.\nEsperamos que vuelva a visitar nuestra p�gina pronto.\n";
        }

        $direccion_retorno = $lista_destinatarios[0];
        &envia_mensaje($asunto, $direccion_retorno, $CAMPOS{'remitente'}, '', '', $mensaje_respuesta);
    }
}


##################################################################
sub valida_email {
    $testmail = $CAMPOS{'remitente'};
    if ($testmail =~ / /) {
        return 0;
    }

    if (    $testmail =~ /(@.*@)|(\.\.)|(@\.)|(\.@)|(^\.)/ ||
        $testmail !~ /^.+\@(\[?)[a-zA-Z0-9\-\.]+\.([a-zA-Z]{2,3}|[0-9]{1,3})(\]?)$/ ) {
        return 0;
    } else {
        return 1;
    }
}


##################################################################
sub envia_mensaje {

  local($subject, $from, $to, $cc, $bcc, $body) = @_;

  local($error) = '';

  # abre sendmail
  if ( $debug ) {
    open(MAIL, ">>$MAIL_FILE") or &muestra_error(2);
  } else {
    open (MAIL, "|$PROGRAMA_SENDMAIL") or &muestra_error(9);
  }

  # construye cabecera del mensaje
  print MAIL "To: <$to>\n";
  print MAIL "From: <$from>\n";
  print MAIL "Cc: <$cc>\n" if $cc;
  print MAIL "Bcc: <$bcc>\n" if $bcc;
  print MAIL "Subject: $subject\n";
  print MAIL "\n";

  if ($body) {
    print MAIL $body;
  }

  print MAIL "\n";
  close MAIL;

}



##################################################################
sub obtiene_fecha {

    local($formato) = @_;

        my @dias = ('Domingo','Lunes','Martes','Mi�rcoles','Jueves','Viernes','S�bado');
        my @meses = ('Enero','Febrero','Marzo','Abril','Mayo','Junio','Julio','Agosto','Septiembre','Octubre','Noviembre','Diciembre');
    my $fecha = '';
    my ($seg, $min, $hor, $diam, $mes, $ano,$wday, $dano, $isdst) = localtime(time);

    my $num_mes = $mes + 1;
    my $copia_ano = ($ano % 100);

    $hor = "0$hor" if ($hor < 10);
    $min = "0$min" if ($min < 10);
    $seg = "0$seg" if ($seg < 10);
    $ano = 1900 + $ano;

    if ($formato eq '1') {
        # Ej.: Jueves, 2 de Enero de 2000, a las 20:30:12
        $fecha = "$dias[$wday], $diam de $meses[$mes] de $ano a las $hor\:$min\:$seg";
    } elsif ($formato eq '2') {
        # Ej.: 2 de Enero de 2000, a las 20:30:12
        $fecha = "$diam de $meses[$mes] de $ano a las $hor\:$min\:$seg";
    } else {
        # Ej.: 02/01/2000 - 20:30:12
        $num_mes = "0$num_mes" if ($num_mes < 10);
        $diam = "0$diam" if ($diam < 10);
        $copia_ano = "0$copia_ano" if ($copia_ano < 10);
        $fecha = "$diam/$num_mes/$copia_ano - $hor\:$min\:$seg";
    }

    return $fecha;
}


##################################################################
sub comprueba_dominio {

  # Obtencion de la pagina desde la que se llama al CGI
  my $pagina = "$ENV{'HTTP_REFERER'}";
  if ( $pagina eq '' ) { &muestra_error(3); }
  my ($http, $dominioypagina) = split(/\/\//,$pagina);  # Separa por //
  my ($dominio, @resto) = split(/\//, $dominioypagina); # Separa por /

  # Correccion obtencion ruta - 19/7/2000
  $resto = join("/", @resto);
  $resto =~ s/[\w-_\.]*\.s{0,1}html{0,1}$//i;       # Elimina nombre pagina
  $resto =~ s/\/{1,2}$//;                   # Elimina caracteres "/" al final

  # Comprobacion de dominio - 25/7/2000
  my $domvalido = 0;
  my (@lista_dominios_validos) = split(/,/, $DOMINIOS_VALIDOS); # Lista de dominios validos
  foreach $dom (@lista_dominios_validos) {
     if ( $dominio =~ /$dom/ ) { $domvalido = 1; last; }
  }

  # Si el dominio no esta en la lista de validos, ERROR!
  if ( $domvalido == 0 ) { &muestra_error(6); }

}


##################################################################
sub muestra_error {
    local($errn, $extrainfo) = @_;
    print "Content-type: text/html\n\n";
    print "<h2>�Error!</h2>\n";
    print "<p>Se ha producido el error $errn</p>\n";
    print "<p>$TipoError[$errn - 1]</p>";
    print "<p>$extrainfo</p>";
    exit(0);
}


##################################################################
# Guarda datos en el log
sub guarda_log {
    my $fecha = &obtiene_fecha('3');
    open (LOGS, ">>$FICHERO_LOG") || &muestra_error(2);
    &lock;
    print LOGS "$ENV{HTTP_REFERER}|$ENV{REMOTE_ADDR}|$fecha\n";
    &unlock;
    close (LOGS);
}

##################################################################
sub lock {
  local($file)=@_;
  flock($file, $LOCK_EX);
}


##################################################################
sub unlock {
  local($file)=@_;
  flock($file, $LOCK_UN);
}