File Coverage

blib/lib/Lemonldap/Portal/Authntsso.pm

Criterion	Covered	Total	%
statement	18	178	10.1
branch	0	36	0.0
condition	0	27	0.0
subroutine	6	26	23.0
pod	6	9	66.6
total	30	276	10.8

package Lemonldap::Portal::Authntsso;
use strict;
use warnings;
use Net::LDAP;
use Authen::Smb;
use Data::Dumper;
use MIME::Base64;
our $VERSION = '0.05';

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}      = \&__credentials;
    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',
        5 => 'wrong credentials',
    };
    $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 {
    my $self = shift;
    my $user = $self->{param}->{'identifiant'};
    $self->{'user'} = $user;
    my $password = $self->{param}->{'secret'};
    $self->{'password'} = $password;
    if (   defined($user)
        or defined($password) )
    {
        if (   !defined($user)
            or $user eq ''
            or !defined($password)
            or $password eq '' )
        {
            $self->{'message'} = $self->{msg}{2};
            $self->{'error'}   = 2;
        }

    }
    if (    !defined($user)
        and !defined($password) )
    {    # empty form
        $self->{'message'} = '';
        $self->{'error'}   = 9;
    }

}
##---------------------------------------------------------------------------
## 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 $user   = $self->{user};
    my $filtre = "uid=$user";
    $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};
}
##---------------------------------------------------------------------------
## Credential against   nt domain
##---------------------------------------------------------------------------
sub __credentials {
    my $self        = shift;
    my $login       = $self->{user};
    my $passwd      = $self->{password};
    my $BDC         = $self->{BDC};
    my $BDC_secours = $self->{BDC_secours};
    my $ntdomain    = $self->{ntDomain};

    unless (
        Authen::Smb::authen( $login, $passwd, $BDC, $BDC_secours || $BDC,
            $ntdomain ) == 0
      )
    {

        $self->{'message'} = $self->{msg}{5};
        $self->{'error'}   = 5;
    }
}

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

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

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

sub getRedirection {
    my $self = shift;
    return ( $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
##  step 12 : validing user's  credentials  upon ntdomain
##------------------------------------------------------------------
    &{ $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__