#!/usr/bin/perl

print "Location: https://cau.uca.es/cau/altaEmailAlumno.do\r\n\r\n";

use lib ( "/opt/Gestion/lib", "/opt/scripts/lib" );

require moduloFormulario;
require funciones;
require GeneraEmail;
require CreaCuentaAlumno;

require CrearCuentaYEmail;

use Net::LDAP;
use Net::LDAP::Util qw(ldap_error_name ldap_error_text);
use Digest::SHA1;

binmode(STDOUT, ":utf8");
binmode(STDERR, ":utf8");

CazaSignals ();

$FONT2 = "FONT SIZE=2 FACE=\"Helvetica,Arial\"";
$FONT3 = "FONT SIZE=3 FACE=\"Helvetica,Arial\"";
$FONT4 = "FONT SIZE=4 FACE=\"Helvetica,Arial\" COLOR=\"#000099\"";
$FONT5 = "FONT SIZE=5 FACE=\"Helvetica,Arial\" COLOR=\"#000099\"";

#my %TITULACION_CENTRO = (
#			 '0306' => 'ADR',
#			 '0406' => 'JTR',
#			 '0407' => 'ATR',
#			 '0805' => 'JEN',
#			 '0807' => 'JEN',
#			 '1505' => 'AEC',
#                         '1506' => 'JEC'
#			 );

if ( $ENV{"HTTPS"} eq "on" || $ENV{"SERVER_PORT"} == 443 ) {
    $mi_direccion_url = "https://melchor.uca.es/";
} else {
    $mi_direccion_url = "http://melchor.uca.es/";
}

umask ( 066 );

$mi_nombre_cgi = "crea-usuario.cgi";
$mi_nombre2_cgi = "crea-usuario2.cgi";


$mensaje_clave_no_correcta = qq{Cuenta de Usuario o Clave de acceso incorrecta.<P> Debe comprobar lo siguiente:
<UL>
<LI>Que su nombre de usuario es la letra "u" y su DNI.<BR> En caso de contener
letras su DNI debe escribirlas en min&uacute;sculas
<LI>Que no tiene pulsada la tecla de may&uacute;sculas.
</UL>
Si despues de estas comprobaciones no le funciona la clave puede acudir a la 
Secretar&iacute;a de su centro para solicitar el cambio de esta. 
};

$mensaje_no_esta_matriculado = qq{No tiene matricula activa.<BR> Es requisito para obtener una direcci&oacute;n de Mensajeria Electronica estar actualmente
matriculado en la UCA.};

$mensaje_no_esta_autorizado = qq{Su cuenta no est&aacute; habilitada.<BR> Debe solicitar que le habiliten la creaci&oacute;n de la direcci&oacute;n de mensajer&iacute;a electr&oacute;nica de la UCA en la Secretar&iacute;a de su centro. Antes de poder crear la direcci&oacute;n.};

print_content_type ();


#ErrorUsuario ( "La aplicación está en mantenimiento, pruebe dentro a partir de las 12 h." );

use DBI;

open ( FICH_CLAVE, "< /opt/Gestion/datos/ca_babel2.txt" );
$clave_babel = <FICH_CLAVE>;
close ( FICH_CLAVE );

$dbh_babel = DBI->connect ( "DBI:Pg:dbname=babel;host=isengard.uca.es", "titanic", $clave_babel ) or ErrorUsuario ( $DBI::errstr );
$dbh_babel->{pg_enable_utf8} = 1;

$quota = "100";
$dominio_cuenta = "alum";

#print_content_type ();

$consulta = $ENV{"QUERY_STRING"};
    
if ( ! $consulta ) {

   ImprimeCuadroAutenticacion ();

} elsif ( $consulta =~ /FASE1/ ) {

    decode_in ();

    # Quita espacios en blanco
    $login =~ s/\s+//g;

    $cuenta_sig = $login;

    if ( $login =~ /u(.*)/i ) {
	$dni = $1;
    } else {
	$dni = $login;
    }

#    $login = lc ( $login );

    $hay_que_crear_la_cuenta = 0;
    $hay_que_crear_el_usuario = 1;

    if ( ! $clave || $clave =~ /^\s*$/ ) {
	ImprimeCuadroAutenticacion ( $mensaje_clave_no_correcta );
    }

    if ( $login !~ /^[\w\d]+$/ ) {
	ImprimeCuadroAutenticacion ( $mensaje_clave_no_correcta );
    }

    # 
    # Comprueba luego si el usuario tiene entrada en la BD de Babel
    # 

    $nif = NormalizaDNI ( $dni );
    $nif = uc ( $nif );
    $dni = uc ( $dni );

    print STDERR "DNI: $dni - NIF: $nif\n";

    $sth_login = $dbh_babel->prepare ( "SELECT login FROM cuentas_alum WHERE idresponsable = '$nif'" ) or ErrorUsuario ( $DBI::errstr ); 
    $sth_login->execute or ErrorUsuario ( $DBI::errstr );
    

    if ( $sth_login->rows > 0 ) {
	my ( $login_actual ) = $sth_login->fetchrow;
	ErrorUsuario ( qq{Ya tiene cuenta de correo electr&oacute;nico. Para acceder a esta conectese a <a href="http://webmail-alum.uca.es/" target="_blank">http://webmail-alum.uca.es/</a> y entre con la cuenta de usuario "$login_actual" y su clave de acceso a los servicios de la UCA.}, 1 );
    }


#    print STDERR "SELECT u.nombre, u.apellido1, u.apellido2, u.carrera, u.departamento, u.centro, ne.clave FROM usuarios_alum u, nuevos_email_alum ne WHERE u.dni = ne.idresponsable AND u.dni = '$nif'\n";

    $sth_babel_usuario = $dbh_babel->prepare ( "SELECT u.nombre, u.apellido1, u.apellido2, u.carrera, u.departamento, u.centro, ne.clave FROM usuarios_alum u, nuevos_email_alum ne WHERE u.dni = ne.idresponsable AND u.dni = '$nif'" );
    $sth_babel_usuario->execute;

    if ( $sth_babel_usuario->rows ) {
	( $nombre, $apellido1, $apellido2, $carrera, $departamento, $centro, $clave_babel ) = $sth_babel_usuario->fetchrow;
	
#	print STDERR qq{( '$nombre', '$apellido1', '$apellido2', '$carrera', '$departamento', '$centro', '$clave_babel' )\n};

	if ( $clave eq $clave_babel ) {
	    $esta_activo = 1;
	    $hay_que_crear_la_cuenta = 1;
	    $hay_que_crear_el_usuario = 0;

	    $borrar_babel_nuevos_email = 1;
	}
	
    }

    #
    # Verifica los alumnos de Erasmus o Visitante o Centro Adscrito
    # 


    $sth_babel_usuario = $dbh_babel->prepare ( "SELECT nombre, apellido1, apellido2, departamento, centro, estamento, tipo_alumno, dominio, clave FROM nuevos_email_alum WHERE idresponsable = '$nif'" );
    $sth_babel_usuario->execute;

    if ( $sth_babel_usuario->rows ) {
	( $nombre, $apellido1, $apellido2, $departamento, $centro, $estamento, $tipo_alumno, $dominio_cuenta, $clave_babel ) = $sth_babel_usuario->fetchrow;
	
	if ( ! $dominio_cuenta ) {
	    $dominio_cuenta = "alum";
	}

	if ( $clave eq $clave_babel ) {
	    $esta_activo = 1;
	    $hay_que_crear_la_cuenta = 1;
	    $hay_que_crear_el_usuario = 1;

	    $borrar_babel_nuevos_email = 0;
	}
	
    }


    # 
    # Comprueba luego si el usuario tiene entrada en la BD de Babel como
    # usuario
    # 

    if ( ! $hay_que_crear_la_cuenta ) {
	$sth_babel_usuario2 = $dbh_babel->prepare ( "SELECT u.nombre, u.apellido1, u.apellido2, u.centro, u.departamento, ne.clave FROM usuarios u, nuevos_email_alum ne WHERE u.dni = ne.idresponsable AND u.dni = '$nif'" );

	$sth_babel_usuario2->execute or ErrorUsuario ( $DBI::errstr );

	if ( $sth_babel_usuario2->rows ) {
	    ( $nombre, $apellido1, $apellido2, $centro, $departamento, $clave_babel ) = $sth_babel_usuario2->fetchrow or ErrorUsuario ( $DBI::errstr );	    
	
	    if ( $clave eq $clave_babel ) {
		
		$esta_activo = 1;
		$hay_que_crear_la_cuenta = 1;
		$hay_que_crear_el_usuario = 0;
		
		$borrar_babel_nuevos_email = 1;
	    }
	    
	}
    }

    #
    # Comprobamos si solo tiene la autenticacion en Babel
    # 

    if ( ! $hay_que_crear_la_cuenta ) {
	$sth_babel_usuario2 = $dbh_babel->prepare ( "SELECT ne.clave FROM nuevos_email_alum ne WHERE ne.idresponsable = '$nif'" );
	$sth_babel_usuario2->execute;
	
	if ( $sth_babel_usuario2->rows ) {
	    ( $clave_babel ) = $sth_babel_usuario2->fetchrow;
	    
	    if ( $clave eq $clave_babel ) {
#	    $hay_que_crear_la_cuenta = 1;
#	    $hay_que_crear_el_usuario = 0;
		
		$ya_esta_autenticado = 1;
		
		$borrar_babel_nuevos_email = 1;
	    }
	
	}
    }


    #
    # Verifica la clave en el LDAP
    #
    # Verifica el LDAP

    my ( $resultado ) = AutenticaLDAP ( $cuenta_sig, $clave );
    
    if ( $resultado ) {
	# LDAP OK

	my ( $nif_login, $tipo_documento_login ) = NIFUsuarioLDAP ( $cuenta_sig );

	if ( $tipo_documento_login ne "NIF" && $tipo_documento_login ne "NIE" ) {

	    $dni = $nif_login;
	}

	print STDERR  qq{crea_usuario.perl: Autenticado LDAP OK: $cuenta_sig -> ( $nif_login, $tipo_documento_login ) DNI: $dni\n};

	$esta_activo = 1;
	$hay_que_crear_la_cuenta = 0;
	$hay_que_crear_el_usuario = 1;
	$ya_esta_autenticado = 1;
    }


    #
    # Comprobamos por ultimo si debe consultar la clave en la maquina
    # de Redcampus
    #

    if ( ! $hay_que_crear_la_cuenta ) {

#	$dbh_seg1 = DBI->connect("dbi:Oracle:", "$cuenta_sig\@seg1.world", $clave, { PrintError => 0, RaiseError => 0 } );

	if ( $ya_esta_autenticado ) {

	    open ( FICH_CLAVE, "< /opt/Gestion/datos/ca_oracle.txt" );
	    $clave_ora = <FICH_CLAVE>;
	    close ( FICH_CLAVE );

	    $dbh_seg1 = DBI->connect("dbi:Oracle:", "infoadmin\@AGORA", $clave_ora, { PrintError => 0, RaiseError => 0 } );


	} else {

	    $dbh_seg1 = DBI->connect("dbi:Oracle:", "$cuenta_sig\@AGORA", $clave, { PrintError => 0, RaiseError => 0 } );

	}

	if ( $dbh_seg1 ) {
	    
	    $esta_activo = 0;
	    $esta_autorizado = 0;
	    
#	    print qq{Content-type: text/html\n\n};
	    print STDERR qq{SELECT dni, nombre, apellido1, apellido2, cod_plan, activo, autorizado FROM infoalumno WHERE dni = '$dni'\n};

	    $sth_oracle = $dbh_seg1->prepare ( "SELECT dni, nombre, apellido1, apellido2, cod_plan, activo, autorizado FROM infoalumno WHERE dni = '$dni'" ) or ErrorUsuario ( $DBI::errstr );
	    $sth_oracle -> execute  or ErrorUsuario ( $DBI::errstr );

#	    print qq{<H3>Rows: } . $sth_oracle->rows . qq{</H3>\n};

#	    if ( $sth_oracle->rows ) {
		while ( @entr_oracle = $sth_oracle->fetchrow ) {
		    ( $dni_o, $nombre_o, $apellido1_o, $apellido2_o, $cod_plan_o, $activo_o, $autorizado_o ) = @entr_oracle;
		
#		    print qq{Content-type: text/html\n\n};
		    
#		    print qq{<H3>( '$dni_o', '$nombre_o', '$apellido1_o', '$apellido2_o', '$cod_plan_o', '$activo_o', '$autorizado_o' )</H3>\n};		   		    

		    if ( $activo_o eq "S" ) {
			$esta_activo = 1;
			( $dni, $cod_plan_a ) = ( $dni_o, $cod_plan_o );
			( $nombre, $apellido1, $apellido2 ) = adapta_nombre ( $nombre_o, $apellido1_o, $apellido2_o );
		    } else {
			( $dni, $cod_plan_a ) = ( $dni_o, $cod_plan_o );
			( $nombre, $apellido1, $apellido2 ) = adapta_nombre ( $nombre_o, $apellido1_o, $apellido2_o );
		    }
		    
		    if ( $autorizado_o eq "S" ) {
			$esta_autorizado = 1;
		    }
		}
#	    } else {
#		ErrorUsuario ( "Error Interno" );
#	    }
	    
	    # Lo crea aunque no esta activo
#            if ( $activo_o ne "S" ) {
#		( $dni, $cod_plan_a ) = ( $dni_o, $cod_plan_o );
#		( $nombre, $apellido1, $apellido2 ) = adapta_nombre ( $nombre_o, $apellido1_o, $apellido2_o );	
#	    }


	    # Quitado no tiene matricula activa para prevenir problemas con alumnos de tercer ciclo

# Quitado 05/09/2003 
#	    if ( ! $esta_activo ) {
#		ErrorUsuario ( $mensaje_no_esta_matriculado, 1 );
#	    }
	    
#	    if ( ! $esta_autorizado ) {
#	        ErrorUsuario ( $mensaje_no_esta_autorizado, 1 );
#	    }

	    # Detecta si no lee correctamente el nombre y apellidos
	    
	    if ( ( ! $nombre || $nombre =~ /^\s*$/ ) ||  ( ! $apellido1 || $apellido1 =~ /^\s*$/ )) {

		print STDERR "Error Interno: No nombre: - $login - '$dni_o', '$nombre_o', '$apellido1_o', '$apellido2_o', '$cod_plan_o', '$activo_o', '$autorizado_o'\n";
		ErrorUsuario ( "Error Interno" );
	    }

	    # Obtiene el codigo de centro
	    $sth_centro = $dbh_seg1->prepare ( "SELECT cod_centro FROM UXXIAC.INFO_ALUMNO_CENTRO WHERE dni = '$dni' AND activo = 'S'" ) or ErrorUsuario ( $DBI::errstr );
	    $sth_centro -> execute  or Error ( $DBI::errstr );
	    while ( @entr_centro = $sth_centro->fetchrow ) {
		( $cod_centro ) = @entr_centro;
	    }


	    if ( $cod_plan_a eq "ERAS" ) {
		$estamento = "9";
		$tipo_alumno = "S";
		$departamento = "ALMA";
	    } elsif ( $cod_plan_a =~ /(\d{2})\d{2}/ ) {

		if ( $cod_centro ) {
		    $carrera = int ( $cod_centro );
		} else {
		    $carrera = int ( $1 );
		}
		
		if ( $carrera >= 70 ) {

		    #
		    # En el caso que el cod_plan comience por 7 debe obtenerse
		    # el departamento desde el idprograma 
		    #
		    $departamento = "ALMA";
		    $estamento = "8";
		    $tipo_alumno = "3";

		} elsif ( $carrera == 51 ) {
		    $departamento = "AADS";
		    $centro = "SAI";
		    $estamento = "N";
		    $dominio_cuenta = "ca";

		} elsif ( $carrera >= 61 && $carrera <= 63 ) {

		    $departamento = "MAYO";
		    $centro = "AUM";
		    $estamento = "M";

		} else {
#		    if ( $TITULACION_CENTRO{$cod_plan_a} ) {
#			$centro = $TITULACION_CENTRO{$cod_plan_a};
#		    } else {

			$sth_oc = $dbh_babel->prepare ( "SELECT centro  FROM carreras_alum WHERE carrera = '$carrera'" ) or Error ( $DBI::errstr );
			$sth_oc -> execute;
		    
			if ( $sth_oc->rows ) {
			    ( $centro ) = $sth_oc->fetchrow;
			} else {
			    ( $centro ) = ( "INC" );
			}
#		    }
		    $tipo_alumno = "A";
		    $estamento = "3";
		    $departamento = "ALMA";
		}
	    } elsif ( ! $estamento ) {
		$tipo_alumno = "A";
		$estamento = "3";
		$departamento = "ALMA";
	    }

	    $hay_que_crear_la_cuenta = 1;
	} else {
	    if ( $DBI::errstr =~ /ORA\-01017/ ) {
		ImprimeCuadroAutenticacion ( $mensaje_clave_no_correcta );
	    } else {
		print STDERR "Error Interno: No nombre: - $login - '$dni_o', '$nombre_o', '$apellido1_o', '$apellido2_o', '$cod_plan_o', '$activo_o', '$autorizado_o'\n";
		ErrorUsuario ( "Error Interno" );
	    }
	}
    }

    if ( $hay_que_crear_la_cuenta ) {

	$comentario = "$nombre $apellido1 $apellido2";
	$comentario =~ s/\'//g;
	$nombre =~ s/\'//g;
	$apellido1 =~ s/\'//g;
	$apellido2 =~ s/\'//g;
	$password = $clave;
    
# Obtener Direccion de Email
	
	@emails = GeneraDireccionEmail ( $login, $nombre, $apellido1, $apellido2, $dominio_cuenta, $estamento ); 
	$sid = GeneraIdentificadorSesion ();
	
	GuardaSesion ( $sid, $dni, $login, $clave, $nombre, $apellido1, $apellido2, $hay_que_crear_el_usuario, $carrera, $departamento, $centro, $tipo_alumno, $estamento, $dominio_cuenta );
	
	print qq{<HTML>
<HEAD>
<TITLE>Creacion de Cuenta de Usuario</TITLE>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8"/>
</HEAD>
<BODY BGCOLOR=\"ffffff\">
};
    
    print qq{


<CENTER><$FONT5><B>Creaci&oacute;n de una cuenta de Mensajer&iacute;a Electr&oacute;nica</B></FONT></CENTER>
<P>

<DL>
<DD>
<TABLE>
<TR><TD><B><$FONT4>Nombre:</FONT></B></TD><TD><B><$FONT3>$comentario</FONT></B></TD></TR>
</TABLE>
</DL>

};

    print qq{<DD><$FONT3><B>Seleccione de las siguientes su nueva direcci&oacute;n de Mensajer&iacute;a Electr&oacute;nica:</B></FONT><P>\n};

    print qq{<FORM ACTION="$mi_nombre2_cgi?FASE2-$sid" METHOD="POST" NAME="form1">\n};

    print "<DL><DD><DL>\n";

    my $cuenta = 0;
    my $CHECKED = "";
    foreach $email_a ( @emails ) {
	if ( ! $cuenta ) { 
	    $CHECKED = " checked=\"true\"";
	} else {
	    $CHECKED = "";
	}
	print qq{<dd><label><input type="RADIO" name="email" value="$email_a"$CHECKED></input> &nbsp; <$FONT3>$email_a\@$dominio_cuenta.uca.es</FONT></label></dd>\n};
	$cuenta ++;
    }
   
    print "</DL></DL>\n";

    print qq{<CENTER><INPUT TYPE=SUBMIT VALUE="Continuar"></CENTER>};

    print qq{</FORM>};

    }

} elsif ( $consulta =~ /FASE2-([\w\d]+)/ ) {

    decode_in ();

    $sid = ( $1 );

    ( $dni, $login, $clave, $nombre, $apellido1, $apellido2, $hay_que_crear_el_usuario, $carrera, $departamento, $centro, $tipo_alumno, $estamento, $dominio_cuenta ) =  LeeSesion ( $sid );

    if ( ! $dni ) {
	ErrorUsuario ( "Sesi&oacute;n no valida, debe comenzar de nuevo la autenticaci&oacute;n" );
    }
    if ( ! $email ) {
	ErrorUsuario ( "Debe seleccionar uno de los email ofrecidos" );
    }


    $login = lc ( $login );


    $nif = NormalizaDNI ( $dni );
    $comentario = "$nombre $apellido1 $apellido2";
    $comentario =~ s/\'//g;
    $nombre =~ s/\'//g;
    $apellido1 =~ s/\'//g;
    $apellido2 =~ s/\'//g;
    $password = $clave;
    
#    print qq{Content-type: text/html\n\n};
#    print qq{<H3>( '$dni', '$login', '$clave', '$nombre', '$apellido1', '$apellido2', '$hay_que_crear_el_usuario', '$carrera' )( '$nif', '$comentario', '$password'  )</H3>\n};
#    exit;

    $sth_login = $dbh_babel->prepare ( "SELECT login FROM cuentas_alum WHERE idresponsable = '$nif'" ) or ErrorUsuario ( $DBI::errstr ); 
    $sth_login->execute or ErrorUsuario ( $DBI::errstr );
    
    if ( $sth_login->rows > 0 ) {
	my ( $login_actual ) = $sth_login->fetchrow;
	ErrorUsuario ( qq{Ya tiene cuenta de correo electr&oacute;nico. Para acceder a esta conectese a http://webmail-alum.uca.es/ y entre con la cuenta de usuario "$login_actual" y su clave de acceso a los servicios de la UCA.}, 1 );
    }

    $sth_login = $dbh_babel->prepare ( "SELECT login FROM cuentas_alum WHERE login = '$login'" ) or ErrorUsuario ( $DBI::errstr ); 
    $sth_login->execute or ErrorUsuario ( $DBI::errstr );
    
    if ( $sth_login->rows > 0 ) {
	ErrorUsuario ( "Login repetido" );
    }
    
    $sth_email = $dbh_babel->prepare ( "SELECT email FROM aliases_alum WHERE email = '$email' AND dominio_email = '$dominio_cuenta'" ) or ErrorUsuario ( $DBI::errstr ); 
    $sth_email->execute or ErrorUsuario ( $DBI::errstr );
    
    if ( $sth_email->rows > 0 ) {
	ErrorUsuario ( "Direcci&oacute;n Email repetida" );
    }
    
    ( $grupo, $gid, $directorio_grupo ) = ObtenerGrupo ( $dni );

#
    $uid = nuevo_uid ( );
    if ( ! $uid || $uid < 100 ) {
	ErrorUsuario ( "Error Interno: No puedo obtener el UID" );
    }

    $sth_serv_buzon = $dbh_babel->prepare ( "SELECT serv_buzon, count(*) FROM cuentas_alum WHERE serv_buzon LIKE 'buzon-alumnos%' GROUP BY serv_buzon HAVING serv_buzon <> '' ORDER BY 2" ) or Error ( $DBI::errstr );
     $sth_serv_buzon -> execute or Error ( $DBI::errstr );

    my ( $serv_buzon ) = $sth_serv_buzon  -> fetchrow;

    my $passwd = encrypt_passwd($login,$password);

    #
    # Crea el usuario en Babel
    #
    
    if ( $dbh_babel ) {
	$sth_babel_r = $dbh_babel->prepare ( "SELECT idresponsable, tipo FROM responsables WHERE idresponsable = '$nif'" );
	$sth_babel_r->execute;
	
	if ( ! $sth_babel_r->rows ) {	
	    ConsultaBabel ( $dbh_babel, "INSERT INTO responsables ( idresponsable, descripcion, tipo, departamento, centro ) VALUES ( '$nif', '$nombre $apellido1 $apellido2', 'ALU', '$departamento', '$centro' ) " );        
	} else {
	    my ( $idresponsable, $tipo_responsable ) = $sth_babel_r->fetchrow;

	    if ( $tipo_responsable eq "IES" ) {
		ConsultaBabel ( $dbh_babel, "UPDATE responsables SET descripcion = '$nombre $apellido1 $apellido2', tipo = 'ALU', departamento = '$departamento', centro = '$centro' WHERE idresponsable = '$nif'" );        

	    }
	}
    }

    if ( $dbh_babel ) {
	$sth_babel_usr = $dbh_babel->prepare ( "SELECT dni FROM usuarios_alum WHERE dni = '$nif'" );
	$sth_babel_usr->execute;
	
	if ( ! $sth_babel_usr->rows ) {
	    ConsultaBabel ( $dbh_babel, "INSERT INTO usuarios_alum ( dni, nombre, apellido1, apellido2, carrera, tipo, departamento, centro, estamento, activo ) VALUES ( '$nif', '$nombre', '$apellido1', '$apellido2', '$carrera', '$tipo_alumno', '$departamento', '$centro', '$estamento', 'S' ) " );     
	}
    }
	
    # 
    # Crea la cuenta de usuario en Babel
    #

    ConsultaBabel ( $dbh_babel, "INSERT INTO cuentas_alum ( login, idresponsable, passwd, uid, caducidad, quota, comentario, directorio, grupo, serv_buzon ) VALUES ( '$login', '$nif', '$passwd', '$uid', '$fecha_caduca', '$quota', '$comentario', '$directorio_grupo', '$grupo', '$serv_buzon' )" );
    
    ConsultaBabel ( $dbh_babel, "INSERT INTO cuentas_cluster ( login, migrada ) VALUES ( '$login', 't' )" );

    # Permite crear cuentas del dominio mail, pero loas almacena como alum
    my $dominio_cuenta_babel = $dominio_cuenta;
    if ( $dominio_cuenta eq "mail" ) {
	$dominio_cuenta_babel = "alum";
    } elsif ( $dominio_cuenta eq "fueca" ) {
	$dominio_cuenta_babel = "alum";
    } elsif ( $dominio_cuenta eq "cta" ) {
	$dominio_cuenta_babel = "alum";
    }

    if ( $email ) {
	#
	# Crea la cuenta de Email en Babel
	#

	my ($sec,$min,$hora,$day,$mon,$year) = (localtime(time))[0..5];
	my $fecha_hoy = sprintf ( "%04d-%02d-%02d", $year + 1900, $mon + 1, $day );

	ConsultaBabel ( $dbh_babel, "INSERT INTO aliases_alum ( idresponsable, login, email, ultimocambio, dominio, dominio_email ) VALUES ( '$nif', '$login', '$email', '$fecha_hoy', '$dominio_cuenta_babel', '$dominio_cuenta' )" );

    }

    # Agnade el usuario al Webmail

    open ( FICH_CLAVE, "< /opt/Gestion/datos/ca_webmerlin.txt" );
    $clave_webmail = <FICH_CLAVE>;
    close ( FICH_CLAVE );

    $dbh_webmerlin = DBI->connect ( "DBI:Pg:dbname=webmerlin;host=bdwebmerlin-alum.uca.es", "webmerlin", $clave_webmail ) or ErrorUsuario ( $DBI::errstr );
    $dbh_webmerlin->{pg_enable_utf8} = 1;

    if ( $dbh_webmerlin ) {
	my $sth_d_datos = $dbh_webmerlin->prepare ( "DELETE FROM usuarios WHERE login = '$login' AND servidor = '$dominio_cuenta_babel'" );
	$sth_d_datos->execute;

	print STDERR "INSERT INTO usuarios ( login, email, nombre, servidor ) VALUES ( '$login', '$email\@$dominio_cuenta.uca.es', '$comentario', '$dominio_cuenta_babel' )";

	my $sth_i_datos = $dbh_webmerlin->prepare ( "INSERT INTO usuarios ( login, email, nombre, servidor ) VALUES ( '$login', '$email\@$dominio_cuenta.uca.es', '$comentario', '$dominio_cuenta_babel' )" );

	$sth_i_datos->execute;
    }
   
    $passwd = CreaUsuario ( $login, $password, $uid, $grupo, $comentario, $grupo, $directorio_grupo, $fecha_caduca, $dominio_cuenta );
    
    if ( $email ) {
	NuevoAlias ( $email, $login, $dominio_cuenta );
    }

    print qq{<HTML>
<HEAD>
<TITLE>Creada Cuenta de Usuario</TITLE>
<BASE TARGET="_TOP">
</HEAD>
<BODY BGCOLOR=\"ffffff\">
};

    print qq{


<CENTER><IMG SRC="imagenes/logo3c.gif"></CENTER>
<P>


<CENTER><$FONT5><B>Su cuenta de Mensajer&iacute;a Electr&oacute;nica<BR> ha sido creada con Exito.</B></FONT></CENTER>
<P>

<CENTER><$FONT3><B><I>Se recomienda que Imprima estos datos</I></B></FONT></CENTER>
<P>

<$FONT4><B>Los datos de su cuenta son los siguientes:</B></FONT>

<DL>
<DD>
<TABLE>
<TR><TD><B><$FONT4>Nombre:</FONT></B></TD><TD><B><$FONT3>$comentario</FONT></B></TD></TR>
<TR><TD><B><$FONT4>Cuenta de Usuario:</FONT></B></TD><TD><B><$FONT3>$login</FONT></B></TD></TR>
<TR><TD><B><$FONT4>Direcci&oacute;n Email:</FONT></B></TD><TD><B><$FONT3>$email\@$dominio_cuenta.uca.es</FONT></B></TD></TR>
<TR><TD><B><$FONT4>Password:</FONT></B></TD><TD><B><$FONT3><I>&lt; Clave que ha usado para crear este email &gt;</I></FONT></B></TD></TR>
</TABLE>
</DL>

<$FONT4><B>Como acceder a su Mensajer&iacute;a Electr&oacute;nica</B></FONT>

<DL>
<DD>
<$FONT3>
<p>
    Puede acceder a su mensajer&iacute;a electr&oacute;nica desde cualquier navegador de la Web (Firefox, Internet Explorer, Netscape, ...), para ello solo debe conectarse a la direcci&oacute;n: <B><A HREF="http://webmail-$dominio_cuenta_babel.uca.es" target="_blank">http://webmail-$dominio_cuenta_babel.uca.es</A></B>.
</p>
<p>
    Desde esa direcci&oacute;n podr&aacute; acceder a un sencillo cliente WebMail que le permitir&aacute; consultar su email, enviar nuevos email, organizar sus mensajes por carpetas, crear una agenda con listas de direcciones de email, definir filtros de mensajes, ... entre otras opciones.
</p>
<p>
Si ya tiene otra direcci&oacute;n de correo electr&oacute;nico y quiere que su email se env&iacute;e a esa direcci&oacute;n, puede hacerlo desde el apartado <b>Redireccionar Email</b>.
</p>
<p>
    Puede acceder a esta aplicaci&oacute;n desde cualquier ordenador de la red de la UCA, desde las aulas de la UCA y desde cualquier ordenador conectado a Internet.
</p>
<P>
Tiene otra forma alternativa de acceso mediante un cliente POP3 (<b>Thunderbird</b>, <b>KMail</b>, <b>Evolution</b>, <B>Eudora</B>, <B>Outlook</B>, ...). <B><A HREF="/ayuda/configuracion.html" target="_blank">Instrucciones para leer su mensajer&iacute;a electr&oacute;nica mediante POP3</A></B>. 


<P>
    Le recomendamos que cambie su password (clave de acceso) de forma inmediata, en el nuevo password debe incluir combinaci&oacute;n de may&uacute;sculas y min&uacute;sculas y al menos 7 letras o n&uacute;meros. Puede cambiar su password desde el apartado: <B>Cambiar Password</B>, de la pagina principal.
<P>


</FONT>
</DL>

<!--
<A HREF="http://www.uca.es/serv/ai/estructura/normativa-reduca.html" target="_blank"><$FONT4><B>Normativa de uso de la Red Inform&aacute;tica de la Universidad de C&aacute;diz</B></FONT></A>

<DL>
<DD>
<$FONT3>
Todos los usuarios del servicio de mensajer&iacute;a electr&oacute;nica se someten formalmente desde la solicitud de la cuenta al cumplimiento de la Normativa establecida a tal efecto por la UCA.
</FONT>
</DL>
<P>
-->

<A HREF="https://cau.uca.es/docs/condicionesusoemail.pdf" target="_blank"><$FONT4><B>Condiciones de uso del servicio de correo electr&oacute;nico de la UCA</B></FONT></A>

<DL>
<DD>
<$FONT3>
Todos los usuarios del servicio de mensajer&iacute;a electr&oacute;nica se comprometen al cumplimiento de las <a href="https://cau.uca.es/docs/condicionesusoemail.pdf" target="_blank">Condiciones de uso del servicio de correo electr&oacute;nico de la UCA</a>.
</FONT>
</DL>
<P>




<$FONT4><B>Cual es su direcci&oacute;n email y desde donde le pueden y a quien puede enviar email</B></FONT>

<DL>
<DD>
<$FONT3>
Su direcci&oacute;n de email es: <B>$email\@$dominio_cuenta.uca.es</B>, a esta direcci&oacute;n le pueden enviar mensajes de correo electr&oacute;nico desde cualquier lugar del mundo (Internet), sin limitaci&oacute;n alguna.<P>
Igualmente usted puede enviar mensajes a cualquier direcci&oacute;n email de Internet.

</FONT>
</DL>


<$FONT4><B>Cual es el espacio en disco para el buz&oacute;n de mensajes.</B></FONT>

<DL>
<DD>
<$FONT3>
El servidor de mensajer&iacute;a tiene unos recursos limitados y por tanto los usuarios tienen una cuota de espacio en disco. Tiene asignado un espacio en disco en el servidor de $quota Mbytes. Si supera esta capacidad no le sera posible recibir nuevos email hasta que haya borrado o se haya bajado con un cliente POP3  mensajes antiguos. 
<p>
Cuando este cerca de superar esa capacidad el sistema le enviar&aacute; un email de aviso.
</FONT>
</DL>


<$FONT4><B>Como obtener m&aacute;s ayuda y resoluci&oacute;n de problemas</B></FONT>

<DL>
<DD>
<$FONT3>
    Desde el bot&oacute;n de ayuda de la aplicaci&oacute;n WebMail puede obtener ayuda de esta aplicaci&oacute;n y sobre el servicio de correo.
<p>

Puede realizarnos consultas relativas a su email desde el <a href="http://cau.uca.es/cau/grupoServicios.do?id=COR" target="_blank">Centro de Atenci&oacute;n al Usuario (CAU)</a>.


</FONT>
</DL>

</BODY>
</HTML>
};

    $sth_babel_nuevos_email = $dbh_babel->prepare ( "DELETE FROM nuevos_email_alum WHERE idresponsable = '$nif'" ) or ErrorUsuario ( $DBI::errstr );
    $sth_babel_nuevos_email->execute or ErrorUsuario ( $DBI::errstr );;
   


}

sub ErrorUsuario ($;$) {
    my ( $error, $modo ) = @_;
    
    print STDERR "ErrorUsuario - $login - $error";

    print_content_type ( );

    print qq{
<HTML>
<HEAD>
<TITLE>Error: $error</TITLE>
</HEAD>
<BODY BGCOLOR=\"ffffff\">

<CENTER>
<TABLE WIDTH=75%>
<TR>
<TD>
<CENTER><FONT SIZE=4 FACE=\"Helvetica,Arial\"><B>ERROR</B></FONT></CENTER><P>

<FONT SIZE=4 FACE=\"Helvetica,Arial\" COLOR=\"#000099\">
};

    if ( ! $modo ) {

	print qq{
Cuando se intentaba crear su cuenta se correo en el servidor se ha producido el siguiente error: <B>$error</B><P>

Intentelo de nuevo dentro de unos momentos y si sigue produciendose el error notifiquelo al personal responsable del mantenimiento del aula que le asesorar&aacute; sobre el motivo que lleva a producir este error.<P>

<DD>Disculpe las molestias.<P>
};

    } else {

	print qq{
En el proceso de crear su cuenta de correo en el servidor se ha producido el siguiente error: <B>$error</B><P>
};

    }

    print qq{<!-- } . longmess () . qq{ -->\n};

    print qq{
</FONT>
</TD>
</TR>
</TABLE>
</CENTER>

</BODY>
</HTML>

};

    exit;
}

sub longmess {

    return @_ if ref $_[0];
    my $error = join '', @_;
    my $mess = "";
    my $i = 1 + $CarpLevel;
    my ($pack,$file,$line,$sub,$hargs,$eval,$require);
    my (@a);
    #
    # crawl up the stack....
    #
    while (do { { package DB; @a = caller($i++) } } ) {
	# get copies of the variables returned from caller()
	($pack,$file,$line,$sub,$hargs,undef,$eval,$require) = @a;
	#
	# if the $error error string is newline terminated then it
	# is copied into $mess.  Otherwise, $mess gets set (at the end of
	# the 'else {' section below) to one of two things.  The first time
	# through, it is set to the "$error at $file line $line" message.
	# $error is then set to 'called' which triggers subsequent loop
	# iterations to append $sub to $mess before appending the "$error
	# at $file line $line" which now actually reads "called at $file line
	# $line".  Thus, the stack trace message is constructed:
	#
	#        first time: $mess  = $error at $file line $line
	#  subsequent times: $mess .= $sub $error at $file line $line
	#                                  ^^^^^^
	#                                 "called"
	if ($error =~ m/\n$/) {
	    $mess .= $error;
	} else {
	    # Build a string, $sub, which names the sub-routine called.
	    # This may also be "require ...", "eval '...' or "eval {...}"
	    if (defined $eval) {
		if ($require) {
		    $sub = "require $eval";
		} else {
		    $eval =~ s/([\\\'])/\\$1/g;
		    if ($MaxEvalLen && length($eval) > $MaxEvalLen) {
			substr($eval,$MaxEvalLen) = '...';
		    }
		    $sub = "eval '$eval'";
		}
	    } elsif ($sub eq '(eval)') {
		$sub = 'eval {...}';
	    }
	    # if there are any arguments in the sub-routine call, format
	    # them according to the format variables defined earlier in
	    # this file and join them onto the $sub sub-routine string
	    if ($hargs) {
		# we may trash some of the args so we take a copy
		@a = @DB::args;	# must get local copy of args
		# don't print any more than $MaxArgNums
		if ($MaxArgNums and @a > $MaxArgNums) {
		    # cap the length of $#a and set the last element to '...'
		    $#a = $MaxArgNums;
		    $a[$#a] = "...";
		}
		for (@a) {
		    # set args to the string "undef" if undefined
		    $_ = "undef", next unless defined $_;
		    if (ref $_) {
			# dunno what this is for...
			$_ .= '';
			s/'/\\'/g;
		    }
		    else {
			s/'/\\'/g;
			# terminate the string early with '...' if too long
			substr($_,$MaxArgLen) = '...'
			    if $MaxArgLen and $MaxArgLen < length;
		    }
		    # 'quote' arg unless it looks like a number
		    $_ = "'$_'" unless /^-?[\d.]+$/;
		    # print high-end chars as 'M-<char>' or '^<char>'
		    s/([\200-\377])/sprintf("M-%c",ord($1)&0177)/eg;
		    s/([\0-\37\177])/sprintf("^%c",ord($1)^64)/eg;
		}
		# append ('all', 'the', 'arguments') to the $sub string
		$sub .= '(' . join(', ', @a) . ')';
	    }
	    # here's where the error message, $mess, gets constructed
	    $mess .= "\t$sub " if $error eq "called";
	    $mess .= "$error at $file line $line\n";
	}
	# we don't need to print the actual error message again so we can
	# change this to "called" so that the string "$error at $file line
	# $line" makes sense as "called at $file line $line".
	$error = "called";
    }
    # this kludge circumvents die's incorrect handling of NUL
    my $msg = \($mess || $error);
    $$msg =~ tr/\0//d;
    $$msg;
}


1;




sub ImprimeCuadroAutenticacion (;$) {

    my ( $motivo_str ) = @_;

   print qq{<HTML>
<HEAD>
<TITLE>Creacion de Cuenta de Usuario</TITLE>
</HEAD>
<BODY BGCOLOR=\"ffffff\">

<CENTER>
<IMG SRC="imagenes/logo3c.gif"><P>
</CENTER>

};


print qq{

<CENTER><$FONT5><B>Creaci&oacute;n de una direcci&oacute;n de<BR> Mensajer&iacute;a Electr&oacute;nica de la UCA</B></FONT></CENTER>
<P>

};

    if ( $motivo_str ) {
	print qq{<CENTER><TABLE BORDER=0 CELLSPACING=5 CELLPADDING=5 WIDTH=80% BGCOLOR="#F7F7FF"><TR><TD><$FONT3 COLOR=RED><B>Error:</B></FONT> <$FONT3><B>$motivo_str</B></FONT></TD></TR></TABLE></CENTER><P>};
    }

    if ( $ENV{"HTTP_HOST"} eq "webmail-ca.uca.es" ) {

    print qq{
<CENTER><TABLE WIDTH=80%>
<TR><TD> 
<$FONT2> 
<P>
    Para obtener una direcci&oacute;n de mensajer&iacute;a electr&oacute;nica debe introducir
su nombre de usuario y clave de acceso inicial.
<P>
    El <B>nombre de usuario</B> es normalmente una <B>"u"</B> seguida de su <B>dni</B>. Si no conoce su <B>clave de acceso</B> puede acudir a la <B>Secretar&iacute;a de su centro</B> para solicitarla.
<P>  
</FONT>
</TD></TR>
</TABLE></CENTER>
};



    } else {

    print qq{
<CENTER><TABLE WIDTH=80%>
<TR><TD> 
<$FONT2> 
<P>
    Para obtener una direcci&oacute;n de mensajer&iacute;a electr&oacute;nica debe introducir
su nombre de usuario y clave de acceso a los servicios de la UCA.
<P>
    La <B>cuenta de usuario</B> es normalmente una <B>"u"</B> seguida de su <B>dni</B>. La <B>clave de acceso</B> es la asignada en el proceso matricula, si desconoce
esta clave puede acudir a la <B>Secretar&iacute;a de su centro</B> para solicitarla.
<P>  
<p>
Al solicitar la cuenta de correo se compremete al cumplimento de las <a href="https://cau.uca.es/docs/condicionesusoemail.pdf" target="_blank">Condiciones de uso del servicio de correo electr&oacute;nico de la UCA</a>
</p>
</FONT>
</TD></TR>
</TABLE></CENTER>
};

}

   print qq{<FORM METHOD=POST ACTION="$mi_nombre_cgi?FASE1">};

   print qq{<CENTER><TABLE>};

   print qq{<TR><TD><$FONT3><B>Cuenta de Usuario:</B></FONT></TD>};

   print qq{</TD><TD>};
   print qq{<INPUT TYPE=TEXT NAME="login" VALUE="$cuenta_sig" SIZE=20>};
   print qq{</TD></TR>};

   print qq{<TR><TD><$FONT3><B>Clave de Acceso:</B></FONT></TD>};

   print qq{</TD><TD>};
   print qq{<INPUT TYPE=PASSWORD NAME="clave" SIZE=20>};
   print qq{</TD></TR>};

   print qq{<TR><TD COLSPAN=2 ALIGN=CENTER>};
   print qq{<INPUT TYPE=SUBMIT VALUE="Continuar">};
   print qq{</TD></TR>};

   print qq{</TABLE></CENTER>\n};

   print qq{</FORM>\n};

    exit;
}

sub CazaSignals () {

    $SIG{"PIPE"} = 'IGNORE';
    $SIG{"STOP"} = \&ManipulaSignals;
    $SIG{"KILL"} = \&ManipulaSignals;
    $SIG{"__DIE__"} = \&ManipulaSignals;
}

sub ManipulaSignals () {
    my($sig) = @_;

    Error ( "Signal: $sig" );
    exit(0);
    return;
}


sub AutenticaLDAP ($$) {

    my ( $login, $password ) = @_;
    my ( $ldap, $mesg, $result );
    my ( $dn_login, $nif );
    my $servidor_ldap = "ldap.uca.es";

#    ( $dn_login ) = DNUsuarioLDAP ( $login );
#    print "DN: ", $dn_login, "\n";

    $dn_login = "cn=$login, dc=uca, dc=es";

    if ( ! $dn_login ) {
	return ( 0 );
    }

    $ldap = Net::LDAP->new($servidor_ldap);
    
    if ( ! $ldap ) {
	return ( 0 );
    }

    $mesg = $ldap->bind ( $dn_login, password => $password, version => 3 );
    
    if ( ! $mesg->code ) {
	return ( "OK" );
    } else {
	return ( undef );
    }
    
    $ldap->unbind;
}

sub DNUsuarioLDAP ($) {
             
    my ( $login ) = @_;
    my ( $ldap, $searchString, $attrs, $base, $result );
    my ( $dn_login, $nif, $mesg, @entries );
    my $servidor_ldap = "ldap.uca.es";

    $ldap = Net::LDAP->new($servidor_ldap);

    if ( ! $ldap ) {
	return ( 0 );
    }

    $mesg = $ldap->bind( version => 3 );

    if ( $mesg->code ) {
	return ( 0 );
    }

    if ( $login ) {
	$searchString = "uid=$login";
    }

    if (!$base ) { $base = "dc=uca, dc=es"; }
        
    if (!$attrs ) { $attrs = ['cn' ]; }
    
    $result = $ldap->search (
				base    => "$base",
				scope   => "sub",
				filter  => "$searchString",
				attrs   =>  $attrs
				);



    @entries = $result->entries;

    if ( $entries[0] ) {
	$dn_login = $entries[0]->dn;
    }

    $ldap->unbind;

    return ( $dn_login );
}



sub NIFUsuarioLDAP ($) {
             
    my ( $login ) = @_;
    my ( $ldap, $searchString, $attrs, $base, $result );
    my ( $dn_login, $nif, $mesg, @entries );
    my ( $nif_login, $tipo_documento_login );
    my $servidor_ldap = "ldap.uca.es";

    $ldap = Net::LDAP->new($servidor_ldap);

    if ( ! $ldap ) {
	return ( 0 );
    }

    $mesg = $ldap->bind( "cn=anonimo, dc=uca, dc=es", password => "anonimo",  version => 3 );

    if ( $mesg->code ) {
	return ( 0 );
    }

    if ( $login ) {
	$searchString = "uid=$login";
    }

    if (!$base ) { $base = "dc=uca, dc=es"; }
        
    if (!$attrs ) { $attrs = ['nif', 'tipodocumento' ]; }
    
    $result = $ldap->search (
				base    => "$base",
				scope   => "sub",
				filter  => "$searchString",
				attrs   =>  $attrs
				);



    @entries = $result->entries;

    if ( $entries[0] ) {
	$nif_login = $entries[0]->get_value( 'nif' );
	$tipo_documento_login = $entries[0]->get_value( 'tipodocumento' );
    }

    $ldap->unbind;

    return ( $nif_login, $tipo_documento_login );
}