#!/usr/bin/perl

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

package Session;
use strict;
use utf8;
use warnings;

use glib_str_03;
use glib_fildir_03;
use lib_cookies;

# ---------------------------------------------------------------
# Errores orientados a que los pueda leer el usuario, sin info del ambiente.
# el texto completo del error se tira al STDERR
our $ERR = '';

# Tiempo de expiracion de la session (tpo max de inactividad para borrar el archivo de la sesion)
our $EXPIRE_SESS_SEGS = 14400; # 4hrs

# ---------------------------------------------------------------
# Crea el objeto y retorna una referencia a el.
sub new {
    my $clase = shift;
    my $sess = {@_};
    bless $sess, $clase;

    # Atributos recibidos.
    $sess->{prontus_id}         ||= '';
    $sess->{document_root}      ||= '';
    $sess->{id_session_given}   ||= ''; # permite ver si un id de sesion es valido aun cuando no haya acceso a cookies, esta es comprobada viendo si existe el file


    # Valida document_root
    if ( ($sess->{document_root} eq '') || (!-d $sess->{document_root}) ) {
        $Session::ERR = "Session::new con params no validos:\n"
                      . "document_root[$sess->{document_root}] \n";
        return 0;
    }

    # Valida prontus_id
    if ( (!-d "$sess->{document_root}/$sess->{prontus_id}") || ($sess->{prontus_id} eq '') ) {
        $Session::ERR = "Session::new con params no validos:\n"
                      . "prontus_id[$sess->{prontus_id}] \n";
        return 0;
    }

    # despulga id de sesion dada
    $sess->{id_session_given} =~ s/\W//sg;

    # set dir de sesiones
    $sess->{dir_sessions} = "$sess->{document_root}/$sess->{prontus_id}/cpan/data/users/sessions";
    if (! &glib_fildir_03::check_dir($sess->{dir_sessions})) {
        $Session::ERR = "Session::new --> no se pudo crear dir de sesiones o este no es valido\n";
        return 0;
    }

    $sess->{id_session} = '';
    $sess->{username} = '';

    # Recupera sesion activa
    my $sesion_existente = $sess->_existe_session();
    if ($sesion_existente ne '') {
        $sess->{id_session} = $sesion_existente;
        my @sesion_data = split(/\|/, &glib_fildir_03::read_file("$sess->{dir_sessions}/$sesion_existente"));
        $sess->{username} = $sesion_data[0];
        $sess->{psw_hash} = $sesion_data[1];
    }

    return $sess;
}

# ---------------------------------------------------------------
# cierra todas las sesiones excepto la actual
sub close_all_other_sessions {
    my $this = shift;

    if (defined($this->{id_session}) && $this->{id_session} ne '') {
        my @lisdir = &glib_fildir_03::lee_dir($this->{dir_sessions});
        @lisdir = grep !/^\./, @lisdir; # Elimina directorios . y ..

        # Borra archivos
        foreach my $entry (@lisdir) {
            if ($entry ne $this->{id_session}) {
                if (-f "$this->{dir_sessions}/$entry") {
                    unlink "$this->{dir_sessions}/$entry";
                }
            }
        }
    }
}

# ---------------------------------------------------------------
# si existe una sesion valida, retorna el id, sino retorna ''
sub _existe_session {
    my $this = shift;

    my $id_session = '';
    if ($this->{id_session_given} ne '') {
        $id_session = $this->{id_session_given};
    } else {
        my %cookies = &lib_cookies::get_cookies();
        $id_session = $cookies{'SESSION_' . $this->{prontus_id}};
    }

    if (defined($id_session) && $id_session ne '') {
        my $mtime = (stat "$this->{dir_sessions}/$id_session")[9];
        if (defined($mtime) && (time - $mtime) < $EXPIRE_SESS_SEGS) {
            return $id_session;
        } else {
            if (!-f "$this->{dir_sessions}/$id_session") {
                print STDERR "Sesion no existe: [$id_session]\n";
            } else {
                print STDERR "Sesion muy antigua: [$id_session][", (time - $mtime),"]\n";
            }
            return '';
        }
    } else {
        print STDERR "No se encuentra sesion";
        print STDERR": [$ENV{'HTTP_COOKIE'}]" if (defined($ENV{'HTTP_COOKIE'}));
        print STDERR "\n";
        return '';
    }
}

# ---------------------------------------------------------------
sub set_new_session {
    my $this = shift;
    my $usr = shift;
    my $psw_hash = shift;
    my $complex_cookie = shift || 0; # si es 1, entonces generamos una cookie usando set_cookie, no set_simple_cookie.

    # Primero detecta si hay una activa y la mata--> basta con q este la cookie
    my %cookies = &lib_cookies::get_cookies();
    my $id_session = $cookies{'SESSION_' . $this->{prontus_id}};
    $this->end_session() if (defined($id_session) && $id_session ne '');

    # Crea la sesion
    eval { $this->{id_session} = UUID4::Tiny::create_uuid_string() };
    if ($@) {
        $this->{id_session} = glib_str_03::random_string(32);
    }

    while (-f "$this->{dir_sessions}/$this->{id_session}") {
        eval { $this->{id_session} = UUID4::Tiny::create_uuid_string()};
        if ($@) {
            $this->{id_session} = glib_str_03::random_string(32);
        }
    }

    &glib_fildir_03::write_file("$this->{dir_sessions}/$this->{id_session}", "$usr|$psw_hash");

    # en el caso de login OIDC, han reportado problemas porque no se genera la cookie de sesión con set_simple_cookie. Usamos entonces este modo más complejo.
    my $cookie = '';
    if ($complex_cookie == 1) {
        my $cookie_params = {
            'name' => "SESSION_$prontus_varglb::PRONTUS_ID",
            'value' => $this->{id_session},
            'httponly' => 1,
            'samesite' => 'Lax',
            'close_headers' => 1,
            'return_string' => 1,
        };
        $cookie = &lib_cookies::set_cookie($cookie_params);
    } else {
        &lib_cookies::set_simple_cookie('SESSION_' . $this->{prontus_id}, $this->{id_session});
    }

    # Garbage de sesiones antiguas
    $this->garbage_sessionid();
    return $cookie if $cookie;
}

# ---------------------------------------------------------------
# Renueva el arch de la sesion para que esta siga activa y no sea borrada por el garbage
sub rejuvenece_sesion {
    my $this = shift;
    my $current_epoch = time;
    utime ($current_epoch, $current_epoch, "$this->{dir_sessions}/$this->{id_session}");
}

# ----------------------------------------------------------------
# Borra archivo y cookie de sesion
sub end_session {
    my $this = shift;
    unlink "$this->{dir_sessions}/$this->{id_session}";
}

# --------------------------------------------------------------------#
sub garbage_sessionid {
    my $this = shift;
    my $dir = $this->{dir_sessions};

    # Lee el contenido del directorio.
    my @lisdir = &glib_fildir_03::lee_dir($this->{dir_sessions});
    @lisdir = grep !/^\./, @lisdir; # Elimina directorios . y ..

    # Borra archivos con mas de EXPIRE_SESS_SEGS de antiguedad
    foreach my $entry (@lisdir) {
        my $mtime = (stat "$this->{dir_sessions}/$entry")[9];
        if (-f "$this->{dir_sessions}/$entry" && (time - $mtime) > $EXPIRE_SESS_SEGS) {
            if ($entry ne $this->{id_session}) {
                unlink "$this->{dir_sessions}/$entry";
            }
        }
    }
}

1;

# ---------------------------------------------------------------
# Para desplegar la doc. desde linea de comandos:
# perldoc Session.pm
# Para generar la doc en html:
# perldoc -T -o html IO::Handle > IO::Handle.html

__END__

=head1 NOMBRE

B<Session.pm> - Clase para emular sesiones en Perl.

=for comment
# ---------------------------------------------------------------

=head1 SINOPSIS

Instanciar y acceder a un metodo publico:

    use Session;

    # Creacion del objeto.
    my $sess_obj = Session->new(
                    'prontus_id'        => 'prontus_noticias',
                    'document_root'     => '/sites/misitio/web')
                    || die("Error inicializando objeto Session: $Session::ERR\n");

    # Obtener id de sesion
    $sess_obj->get_sessionid() || die("Error: $Session::ERR");


=for comment
# ---------------------------------------------------------------

=head1 DESCRIPCION

Contiene operaciones para manipulacion de sesion en Perl

=for comment
# ---------------------------------------------------------------

=head2 VARIABLES DE CLASE, ESTATICAS

=over 8

=item C<$Session::ERR>

Variable que se carga con el texto descriptivo del error en caso de que un metodo retorne 0.
Este texto esta adecuado para ser presentado directamente al usuario, ya que el texto completo
del error, incluyendo paths y backtrace es enviado al STDERR.

=back

=for comment
# ---------------------------------------------------------------

=head2 ATRIBUTOS

Los atributos se acceden de la forma:

    my $attr = $sess_obj->{nombre_atributo};

Los atributos son:

B<id_session>:

    id alfanumerico de la sesion, de 20 caracteres.

B<prontus_id>:

    nombre del publicador Prontus,
    por ejemplo 'prontus_noticias'

B<document_root>:

    document root asociado al server,
    por ejemplo '/sites/misitio/web'

=for comment
# ---------------------------------------------------------------

=head2 METODOS PUBLICOS

=over 8

=for comment
# ---------------------------------------------------------------

=item B<new()>

Devuelve un nuevo objeto Session. Los parametros son los indicados en la sinopsis.

=for comment
# ---------------------------------------------------------------

=item B<renew()>

renueva el archivo de sesion, de manera que no sea tomado por el garbage

=for comment
# ---------------------------------------------------------------

=item B<get_sessionid()>

  Obtiene el id de sesion, por ejemplo
  '8Y9DrMMvguhokmbPV4yx'

=for comment
# ---------------------------------------------------------------

=head1 AUTOR

Yerko Chapanoff, E<lt>yerko@altavoz.netE<gt>

=cut
