File Coverage

blib/lib/Lemonldap/Portal/Sslsso.pm

Criterion	Covered	Total	%
statement	15	156	9.6
branch	0	28	0.0
condition	0	9	0.0
subroutine	5	24	20.8
pod	6	9	66.6
total	26	226	11.5

package Lemonldap::Portal::Sslsso;

use strict;
use warnings;

our $VERSION = '0.03';
use Net::LDAP;
use Data::Dumper;
use MIME::Base64;

sub new {
    my $class = shift;
    my %args  = @_;
    my $self  = bless {}, ref($class) || $class;
    $self->{controlUrlOrigin} = \&__controlUrlOrigin;
    $self->{controlTimeOut}   = \&__controlTimeOut;
    $self->{controlSyntax}    = \&__controlSyntax;
    $self->{bind}             = \&__bind;
    $self->{formateUser}      = \&__none;
    $self->{formateFilter}    = \&__Filter;
    $self->{formateBaseLDAP}  = \&__none;
    $self->{contactServer}    = \&__contactServer;
    $self->{bind}             = \&__bind;
    $self->{search}           = \&__ldapsearch;
    $self->{setSessionInfo}   = \&__session;
    $self->{unbind}           = \&__unbind;
    $self->{credentials}      = \&__none;
    my $mess = {
        1 =>
          'Your connection has expired; You must to be authentified once again',
        2 => 'User and password fields must be filled',
        3 => 'Wrong directory manager account or password',
        4 => 'not found in directory',
    };
    $self->{msg} = $mess;

    foreach ( keys %args ) {
        $self->{$_} = $args{$_};
    }

    return $self;
}
##------------------------------------------------------------------
## method none
## This method  does nothing ..
##------------------------------------------------------------------
sub __none {    #does ...nothing;

}
##------------------------------------------------------------------
## method controlUrlOrigin
## This method looks at param cgi 'urlc'  in order to determine if
## the request comes with  a vip url (redirection)  or for the menu
##------------------------------------------------------------------
sub __controlUrlOrigin {
    my $urldc;
    my $self = shift;
    my $urlc = $self->{param}->{'url'};

    if ( defined($urlc) ) {
        $urldc = decode_base64($urlc);

        #  $urldc =~ s#:\d+/#/#;   # Suppress  port number in  URL
        $urlc = encode_base64( $urldc, '' );
        $self->{'urlc'}  = $urlc;
        $self->{'urldc'} = $urldc;
    }
}
##------------------------------------------------------------------
## method controlTimeOut
## This method looks at param cgi 'op'
## if op eq 't' (like timeout) the handler couldn't retrieve the
## storage session from id session
##------------------------------------------------------------------
sub __controlTimeOut {
    my $self      = shift;
    my $operation = $self->{param}->{'op'};
    $self->{operation} = $operation;
    if ( defined($operation)
        and $operation eq 't' )
    {
        $self->{'message'} = $self->{msg}{1};
        $self->{'error'}   = 1;
    }
}
##------------------------------------------------------------------
## method controlSyntax
## This method looks at param cgi 'identifant' and 'secret'
##
##------------------------------------------------------------------
sub __controlSyntax {

}
##---------------------------------------------------------------------------
## Connection  ldap on server and port ldap
##---------------------------------------------------------------------------

sub __contactServer {
    my $self = shift;
    unless ( $self->{ldap} ) {
        my $ldap = Net::LDAP->new(
            $self->{server},
            port    => $self->{port},
            onerror => undef,
          )
          or die( 'Net::LDAP->new: ' . $@ );
        $self->{ldap} = $ldap;
    }
}

sub func_bind {
    my $ldap     = shift;
    my $dn       = shift;
    my $password = shift;
    my $mesg;
    if ( $dn and $password ) {    #named bind
        $mesg = $ldap->bind( $dn, password => $password );
    }
    else {                        # anonymous bind
        $mesg = $ldap->bind();
    }

    my $me = $mesg->code();
    if ( $mesg->code() != 0 ) {
        $ldap = undef;
        return ("wrong password");
    }
    return;
}

##---------------------------------------------------------------------------
## formate filter
##---------------------------------------------------------------------------
sub __Filter {
    my $self        = shift;
    my $valuecertif = $self->{value_certif};
    my $idcertif    = $self->{field_certif};

    my $filtre = "$idcertif=$valuecertif";
    $self->{filter} = $filtre;
}
##---------------------------------------------------------------------------
## Connection  on  server LDAP with manager credential
## in order to extract user infos
##---------------------------------------------------------------------------

sub __bind {
    my $self = shift;
##---------------------------------------------------------------------------
## Authentification
##---------------------------------------------------------------------------

    my $d = $self->{ldap};
    my $p = $self->{DnManager};
    my $r = $self->{passwdManager};

    my $mesg =
      &func_bind( $self->{ldap}, $self->{DnManager}, $self->{passwordManager} );

    if ($mesg) {
        $self->{'message'} = $self->{sg}{3};
        $self->{'error'}   = 3;

    }
}

sub __ldapsearch {
    my $self   = shift;
    my $ldap   = $self->{ldap};
    my $filter = $self->{filter};
    my $base   = $self->{branch};

    my $mesg = $ldap->search(
        base   => $base,
        scope  => 'sub',
        filter => $filter,
    );
    die $mesg->error() if ( $mesg->code() != 0 );
    my $retour          = $mesg->entry(0);
    my $identifiantCopy = $self->{user};
    if ( !defined($retour) ) {
        $self->{'message'} = "$identifiantCopy :" . $self->{msg}{4};
        $self->{'error'}   = 4;
        return;
    }
    $self->{entry} = $retour;
    return;
}
##==============================================================================
## function _session
##
##==============================================================================

sub __session {
    my $self = shift;
    my %session;
    my $entry = $self->{entry};
    $session{dn}            = $entry->dn();
    $self->{dn}             = $entry->dn();
    $session{uid}           = $entry->get_value('uid');
    $session{cn}            = $entry->get_value('cn');
    $session{personaltitle} = $entry->get_value('personaltitle');
    $session{mail}          = $entry->get_value('mail');
    $session{title}         = $entry->get_value('title');
    $self->{infosession}    = \%session;

}
##==============================================================================
## Function unbind
##  do unbind;
##==============================================================================
sub __unbind {
    my $self = shift;
    $self->{ldap}->unbind if $self->{ldap};
}

sub message {
    my $self = shift;
    return ( $self->{message} );
}

sub infoSession {
    my $self = shift;
    return ( $self->{infosession} );
}

sub getRedirection {
    my $self = shift;
    return ( $self->{urldc} );
}

sub getAllRedirection {
    my $self = shift;
    return ( $self->{urlc}, $self->{urldc} );
}

sub user {
    my $self = shift;
    return ( $self->{user} );
}

sub error {
    my $self = shift;
    return ( $self->{error} );
}

sub process {
    my $self = shift;
    my %args = @_;
    foreach ( keys %args ) {
        $self->{$_} = $args{$_};
    }
##------------------------------------------------------------------
## method process
## This method step after step calls methods for dealing the
## connection
##  step 0  : setting configuration
##  step 1  : manage the source of request
##  step 2  : manage timeout
##  step 3  : control the input form of user and password
##  step 4  : formate the user id if needing
##  step 5  : build the filter for  the  search
##  step 6  : build subtree for the search ldap
##  step 7  : make socket upon ldap server
##  step 8  : bind operation
##  step 9  : make search
##  step 10 : confection of %session from ldap infos
##  step 11 : unbind
##------------------------------------------------------------------
    &{ $self->{controlUrlOrigin} }($self);    # no error avaiable in this step
    &{ $self->{controlTimeOut} }($self);
    return ($self) if $self->{'error'};       ## it's not necessary to go next.
    &{ $self->{controlSyntax} }($self);
    return ($self) if $self->{'error'};       ## it's not necessary to go next.
    &{ $self->{formateUser} }($self);         # no error avaiable in this step
    &{ $self->{formateFilter} }($self);       # no error avaiable in this step
    &{ $self->{formateBaseLDAP} }($self);     # no error avaiable in this step
    &{ $self->{contactServer} }($self)
      ;    # can die if the server if unreachable: critical error
    &{ $self->{bind} }($self);
    return ($self) if $self->{'error'};    ## it's not necessary to go next.
    &{ $self->{search} }($self);

    if ( $self->{'error'} ) {
        ## it's not necessary to go next.
        &{ $self->{unbind} }($self);
        return ($self);
    }
    &{ $self->{setSessionInfo} }($self);    # no error avaiable in this step
    &{ $self->{credentials} }($self);
    &{ $self->{unbind} }($self);            # no error avaiable in this step
    return ($self);
}

1;
__END__