Auth.pm


Code Index:

#
# 	Sebastien.Carerre@toulouse.inra.fr
# 	Celine.noirot@toulouse.inra.fr
#   emmanuel.courcelle@toulouse.inra.fr
#	Created: March 08, 2006
#   Updated: Feb 08
#

package Auth;


NAME

Auth - An object to manage authentification using cookies


=head1 SYNOPSIS

use CGI;
use ParamParser;

my $RH_PARAM = New ParamParser('CGIPM');

 # all parameters are optionnal, not privilege to use function IsPrivilege
 # if you want to retrieve the default cookie specify none
 # if you want to retrieve a specific  cookie specify cookie_name
 # if you want to authentified a user specified login, password, and etcpassword file
 # add cookie name to create a specific cookie name.
 my $file = "/tmp/etcpasswd";
 my @a_privilege=("guest","poweruser","admin");
 $O_AUTH=New Auth({login                =>      $RH_PARAM->Get('__login'), 
                password        =>      $RH_PARAM->Get('__passwd'),
                file            =>      $file,
                cookie          =>      $RH_PARAM->Get('__wb_cookie'),
                cookie_name     =>      "appli",
                cookie_expire   =>      "+1h",
                list_privilege=> \@a_privilege,
        cookie_path => "/path/to/repository/cgi"});
        
 print header(-cookie=>$O_AUTH->GetCookie());
 if ($O_AUTH->IsPrivilege('guest') )
 {
        print "You are guest<br>";
 }
 elsif ($O_AUTH->IsPrivilege('admin') )
 {
        print "You are admin<br>";
 }


DESCRIPTION

The privilege array parameter must correspond to the level in etcpassword file corresponding to a privilege. eg etcpassword file : cnoirot:b4ea23a368b20bc1623e058f392f1fe4:1575:1:celine.noirot@inra.toulouse.fr:/www/LeARN_dev/web/tmp:/bin/tcsh cnoirot = login b4ea23a368b20bc1623e058f392f1fe4 = password_in_MD5 1575 = id(not use) 1 = privilege_number (corresponds to the index in an ordered array of privilege labels) celine.noirot@inra.toulouse.fr = email /www/LeARN_dev/web/tmp = path_workspace /bin/tcsh = shell (not use)

use Data::Dumper;
use Digest::MD5 qw(md5 md5_hex md5_base64);
use strict;
use CGI;
use IO::File;
use LipmError::IOException;

my $COOKIE_NAME = "auth.default";

function New

 Title            : New
 Usage            : $o_auth= New Auth(%hash);
 Prerequisite : none
 Function         : Create a new objet Auth
 Returns          : An object Auth
 Args             : %hash :which contain at least cookie_name
                                and for an authentification a file, login and password are requested.
sub New
{
    my ($class, $h_build_param) = (@_);

    my $self = {
                __file              => "",
                __login             => "",
                __password          => "",
                __ip                => "",
                __ip_valid          => 0,
                __workspace         => "",
                __email             => "",
                __privilege         => 0,
                __cookie            => "",
                __cookie_name       => "$COOKIE_NAME",
                __cookie_expires    => '+24h',
                __a_privilege_label => [],
                __cookie_path       => ""
                };
    bless($self, $class);
    $$h_build_param{'ip'} = $ENV{REMOTE_ADDR} if (defined $ENV{REMOTE_ADDR} && (!defined $$h_build_param{'ip'}));

    # si le nom est specifie on prend en compte ce nom.
    $self->{'__cookie_name'} = $$h_build_param{'cookie_name'}
      if (defined($$h_build_param{'cookie_name'}) && $$h_build_param{'cookie_name'} ne "");
    $self->{'__cookie_expires'} = $$h_build_param{'cookie_expires'}
      if (defined($$h_build_param{'cookie_expires'}) && $$h_build_param{'cookie_expires'} ne "");
    $self->{'__cookie_path'} = $$h_build_param{'cookie_path'}
      if (defined($$h_build_param{'cookie_path'}) && $$h_build_param{'cookie_path'} ne "");

    # liste des privileges
    @{$self->{'__a_privilege_label'}} = @{$$h_build_param{'list_privilege'}}
      if (defined($$h_build_param{'list_privilege'}));

    # The privilege file
    $self->{'__file'} = $$h_build_param{'file'};
    $self->{'__ip'} = $$h_build_param{'ip'} if (defined $$h_build_param{'ip'});

    # Was a (login,password) couple provided ?
    if (   defined($$h_build_param{'login'})
        && defined($$h_build_param{'password'})
        && $$h_build_param{'login'} ne ""
        && $$h_build_param{'password'} ne "")
    {
        $self->{'__login'}    = $$h_build_param{'login'};
        $self->{'__password'} = $$h_build_param{'password'};

        # If the user is authentified, a cookie is created
        $self->CheckAuth();    # si l'utilisateur est connu + bon pwd => Cree un cookie

    }    # si un cookie est passe en parametre on va chercher les info associees

    elsif (defined($$h_build_param{'cookie_name'}))
    {
        $self->InitializeFromCookie($self->{'__cookie_name'});
    }
    elsif (defined($$h_build_param{'cookie'}) && $$h_build_param{'cookie'} ne "")
    {

        my @a_cookie = split(/=/, $$h_build_param{'cookie'});

        # un cookie existe deja ?
        if ($self->ExistCookie($a_cookie[0]))
        {
            $self->InitializeFromCookie($a_cookie[0]);
        }
    }
    elsif (defined($$h_build_param{'ip'}))
    {
        $self->CheckAuth();
    }
    return ($self);
}

function Print

 Title            : Print use it for debug
 Usage            : $o_auth->Print();
 Prerequisite : none
 
=cut
sub Print
{
    my ($self) = (@_);
    print STDERR "file etc passwd : " . $self->{'__file'} . "<br>";
    print STDERR "login : " . $self->{'__login'} . "<br>";
    print STDERR "passwd : " . $self->{'__password'} . "<br>";
    print STDERR "ip : " . $self->{'__ip'} . "<br>";
    print STDERR "workspace : " . $self->{'__workspace'} . "<br>";
    print STDERR "email : " . $self->{'__email'} . "<br>";
    print STDERR "privilege : " . $self->{'__privilege'} . "<br>";
    print STDERR "cookie value : " . $self->{'__cookie'} . "<br>";
    print STDERR "cookie name : " . $self->{'__cookie_name'} . "<br>";
    print STDERR "cookie path : " . $self->{'__cookie_path'} . "<br>";
}

function ExistCookie

 Title            : ExistCookie
 Usage            : $obj_auth->ExistCookie($)
 Prerequisite : none
 Function         : Check if the cookie name "__cookie_name" exists
 Returns          : 1 if cookie exists
                                0 if not exists
 Args             : $name : name of the cookie
sub ExistCookie
{
    my ($self)       = (@_);
    my $o_cgi        = new CGI();
    my $cookie_value = &UrlDecode($o_cgi->cookie($self->{'__cookie_name'}));
    if (defined($cookie_value) && ($cookie_value ne ""))
    {
        return (1);
    }
    else
    {
        return (0);
    }
}

function InitializeFromCookie

 Title            : InitializeFromCookie
 Usage            : $obj_auth->InitializeFromCookie($name)
 Prerequisite : cookie $name must exist
 Function         : For an existing cookie , initialize object auth
 Returns          : none
 Args             : $name : name of the existing cookie
sub InitializeFromCookie
{
    my ($self, $cookie_name) = (@_);

    if ((!defined($cookie_name)) || ($cookie_name eq ""))
    {
        $cookie_name = $self->{'__cookie_name'};
    }
    my $o_cgi        = new CGI();
    my $cookie_value = &UrlDecode($o_cgi->cookie($cookie_name));

    #cnoirot:1575:1:celine.noirot@inra.toulouse.fr:/www/LeARN_dev/web/tmp:/bin/tcsh
    my @a_cook_user = split(/:/, $cookie_value);

    open(USER, $self->{'__file'});
    my $find = 0;
    my @a_user;
    while (my $line = <USER>)
    {
        chomp($line);

        #cnoirot:b4ea23a368b20bc1623e058f392f1fe4:1575:1:celine.noirot@inra.toulouse.fr:/www/LeARN_dev/web/tmp:/bin/tcsh
        next if ($line eq "");
        @a_user = split(/:/, $line);

        #print STDERR "cook user = ".$a_cook_user[0] ." User: ".$a_user[0]."\n";
        if ($a_cook_user[0] eq $a_user[0])
        {
            $find = 1;
            last;
        }
    }
    close(USER);
    if ($find == 1)
    {
        $self->{'__login'}     = $a_user[0];
        $self->{'__ip'}        = $a_user[2];
        $self->{'__privilege'} = $a_user[3];
        $self->{'__workspace'} = $a_user[5];
        $self->{'__email'}     = $a_user[4];
        my $value =
            $a_user[0] . ":"
          . $a_user[2] . ":"
          . $a_user[3] . ":"
          . $a_user[4] . ":"
          . $a_user[5] . ":"
          . $a_user[6];    # on vire le password !!!splice(@{$find},1,1)
        my $path = $self->{'__cookie_path'};
        $self->{'__cookie'} =
          $o_cgi->cookie(
                         -name    => $self->{'__cookie_name'},
                         -value   => $value,
                         -expires => $self->{'__cookie_expires'},
                         -path    => $path
                         );
        $self->{'__cookie_name'} = $cookie_name;
    }
    else
    {
        $self->{'__privilege'} = $a_user[0];
    }
}

function CheckAuth

 Title            : CheckAuth
 Usage            : $obj_auth->CheckAuth();
 Prerequisite : Attributes file / login / password must be set
 Function         : Parse the password file check if login and password a correct.
                                If so, we keep identification data inside the object and we create a cookie
 Returns          : 1 => authentication is ok
                                0 => file, password or login are false
sub CheckAuth
{
    my $self = shift;

    my $found = 0;
    my $value = "";
    my $o_cgi = new CGI();    # Using CGI.pm to set the cookie

    #if (defined ($self->{'__file'}) && (-e $self->{'__file'}) && (-s $self->{'__file'}))
    #{
    #open (USER, $self->{'__file'});
    #
    my $fh_file = new IO::File($self->{'__file'}) or throw LipmError::IOException($self->{'__file'}, 'f');

    #my $fh_file = new IO::File($self->{'__file'}) or die("merde");
    #my $fh_file = new IO::File($self->{'__file'}) ;

    while (my $line = <$fh_file>)
    {
        chomp($line);

        # Each line should have this format:
        #cnoirot:b4ea23a368b20bc1623e058f392f1fe4:1575:1:celine.noirot@inra.toulouse.fr:/www/LeARN_dev/web/tmp:/bin/tcsh

        # blank lines are ignored
        next if ($line eq "");

        # Check for user/password
        my @a_user = split(/:/, $line);

        #print STDERR "me5: " .md5_hex($self->{'__password'}). " : ".$a_user[1]."<br>";

        my $user_ip = $self->{'__ip'};
        if (($self->{'__login'} ne '') && ($self->{'__ip_valid'} == 0))
        {
            if ($a_user[0] eq $self->{'__login'} && $a_user[1] eq md5_hex($self->{'__password'}))    #md5_hex
            {
                $found                 = 1;
                $self->{'__privilege'} = $a_user[3];
                $self->{'__workspace'} = $a_user[5];
                $self->{'__email'}     = $a_user[4];
                $self->{'__login'}     = $a_user[0];

                # We keep those parameters in the cookie, but NOT the password
                $value =
                    $a_user[0] . ":"
                  . $a_user[2] . ":"
                  . $a_user[3] . ":"
                  . $a_user[4] . ":"
                  . $a_user[5] . ":"
                  . $a_user[6];
                my $path = $self->{'__cookie_path'};
                $self->{'__cookie'} = $o_cgi->cookie(
                                                     -name    => $self->{'__cookie_name'},
                                                     -value   => $value,
                                                     -expires => $self->{'__cookie_expires'},
                                                     -path    => $self->{'__cookie_path'}
                                                     );
                last;
            }
        }
        else
        {
            if ($a_user[2] =~ /^\d+\.\d+\./ && $user_ip =~ /^$a_user[2]/)    #controle IP
            {
                $found                 = 1;
                $self->{'__privilege'} = $a_user[3];
                $self->{'__workspace'} = $a_user[5];
                $self->{'__email'}     = $a_user[4];
                $self->{'__login'}     = $a_user[0];
                $self->{'__ip_valid'}  = 1;

                # We keep those parameters in the cookie, but NOT the password
                $value =
                    $a_user[0] . ":"
                  . $a_user[2] . ":"
                  . $a_user[3] . ":"
                  . $a_user[4] . ":"
                  . $a_user[5] . ":"
                  . $a_user[6];
                my $path = $self->{'__cookie_path'};
                $self->{'__cookie'} = $o_cgi->cookie(
                                                     -name    => $self->{'__cookie_name'},
                                                     -value   => $value,
                                                     -expires => $self->{'__cookie_expires'},
                                                     -path    => $self->{'__cookie_path'}
                                                     );
                last;
            }
        }
    }
    return $found;
}

function IsPrivilege

 Title            : IsPrivilege
 Usage            : $obj_auth->IsPrivilege(privilege_name)
 Prerequisite : @A_PRIV is defined
 Function         : Check if self have the same privilege as the param
 Returns          : 1 : if privilege are the same
                                0 : if privilege are different
sub IsPrivilege
{
    my ($self, $name_priv) = @_;
    my $res = 0;
    if ($name_priv eq $self->{'__a_privilege_label'}[$self->{'__privilege'}])
    {
        $res = 1;
    }
    return $res;
}

GetFile
        $o_auth->GetFile();
        Return file attribut
sub GetFile
{
    my $self = shift;
    return $self->{'__file'};
}

SetFile
        $o_auth->SetFile($file);
        Set file attribut
sub SetFile
{
    my ($self, $value) = @_;
    $self->{'__file'} = $value;
}

GetLogin
        $o_auth->GetLogin();
        Return login attribut
sub GetLogin
{
    my $self = shift;
    return $self->{'__login'};
}

SetLogin
        $o_auth->SetLogin($login);
        Set login attribut
sub SetLogin
{
    my ($self, $value) = @_;
    $self->{'__login'} = $value;
}

GetPassword
        $o_auth->GetPassword();
        Return password attribut
sub GetPassword
{
    my $self = shift;
    return $self->{'__password'};
}

SetPassword
        $o_auth->SetPassword($pwd);
        Set password attribut
sub SetPassword
{
    my ($self, $value) = @_;
    $self->{'__password'} = $value;
}

GetIp
        $o_auth->GetIp();
        Return ip attribut
sub GetIp
{
    my $self = shift;
    return $self->{'__ip'};
}

SetIp
        $o_auth->SetIp($ip);
        Set ip attribut
sub SetIp
{
    my ($self, $value) = @_;
    $self->{'__ip'} = $value;
}

GetWorkspace
        $o_auth->GetWorkspace();
        Return workspace attribut
sub GetWorkspace
{
    my $self = shift;
    return $self->{'__workspace'};
}

SetWorkspace
        $o_auth->SetWorkspace($wks);
        Set workspace attribut
sub SetWorkspace
{
    my ($self, $value) = @_;
    $self->{'__workspace'} = $value;
}

GetEmail
        $o_auth->GetEmail();
        Return email attribut
sub GetEmail
{
    my $self = shift;
    return $self->{'__email'};
}

SetEmail
        $o_auth->SetEmail($email);
        Set email attribut
sub SetEmail
{
    my ($self, $value) = @_;
    $self->{'__email'} = $value;
}

GetPrivilege
        $o_auth->GetPrivilege();
        Return privilege attribut
sub GetPrivilege
{
    my $self = shift;
    return $self->{'__privilege'};
}

SetPrivilege
        $o_auth->SetPrivilege($priv);
        Set privilege attribut
sub SetPrivilege
{
    my ($self, $value) = @_;
    $self->{'__privilege'} = $value;
}

GetCookie
        $o_auth->GetCookie();
        Return cookie attribut
sub GetCookie
{
    my $self = shift;
    return $self->{'__cookie'};
}

SetCookie
        $o_auth->SetCookie($cookie);
        Set cookie attribut
sub SetCookie
{
    my ($self, $value) = @_;
    $self->{'__cookie'} = $value;
}

GetCookieName
        $o_auth->GetCookieName();
        Return cookie name attribut
sub GetCookieName
{
    my $self = shift;
    return $self->{'__cookie_name'};
}

SetCookieName
        $o_auth->SetCookieName($cookie);
        Set cookie name attribut
sub SetCookieName
{
    my ($self, $value) = @_;
    $self->{'__cookie_name'} = $value;
}

UrlDecode
        $o_auth->UrlDecode();
        Decode url value

sub UrlDecode
{
    my $string = shift;

    $string =~ tr/+/ /;
    $string =~ s/%([\da-fA-F]{2})/chr (hex ($1))/eg;

    return $string;
}

1;