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);
}