view release on metacpan or  search on metacpan

Login.pm  view on Meta::CPAN

    }
    return $toc;
}


=head3 check_timeout($cgi, $ar)

Input variables: 

  $cgi - CGI object
  $ar  - Array ref containing all the parameters

Variables used or routines called: 

  None.

How to use:

  my $q = new CGI;
  my %cfg = (usr=>'jsmith', pwd=>'jojo');
  my @names = $q->param;
  foreach my $k (@names) { $cfg{$k} = $q->param($k) if ! exists $cfg{$k}; }
  $self->check_timeout($q, \%cfg);

Return: 1 or 0: 1 - timed out; 0 - not timed out

This method checks to see if the session has been timed out.
The default time out is 20 minutes.

=cut

sub check_timeout {
    my $s = shift;
    my ($q, $ar) = @_; 
    my ($cdt,$stm, $tmout) = (time, 0, 0); 
       $stm   = $ar->{stm}             if exists $ar->{stm};
       $tmout = $ar->{session_timeout} if exists $ar->{session_timeout};
    return ($tmout && ($cdt-$stm)>$tmout)?1:0;
}


=head3 get_access ($cgi,$ar)

Input variables:

  $cgi - CGI object
  $ar  - Array ref containing all the parameters

Variables used or routines called: 

  None

How to use:

  my $q = new CGI;
  my %cfg = (usr=>'jsmith', pwd=>'jojo');
  my @names = $q->param;
  foreach my $k (@names) { $cfg{$k} = $q->param($k) if ! exists $cfg{$k}; }
  $self->get_access($q, \%cfg);

Return: $hr - access hash array ref: ${$hr}{uid|gid}{$name} = $uid|$giu

This method retrieves portal access user and group files and access_users and
access_groups in the configuration file to build an access list.

=cut

sub get_access {
    my $s = shift;
    my ($q, $ar) = @_;
    
    require XML::Simple;

    my $ua_list = lc ${$ar}{access_users};
       $ua_list =~ s/\s*,\s*/\|/g;
    my $ga_list = lc ${$ar}{access_groups};
       $ga_list =~ s/\s*,\s*/\|/g;

    # get portal xml access files
    my $xml_grp = ${$ar}{xml_group};
    my $xml_usr = ${$ar}{xml_user};
   
    my $xs = new XML::Simple;
    my $grf = $xs->XMLin($xml_grp);
    my $urf = $xs->XMLin($xml_usr);
    
    my %uid = ();  # User ID   hash array 
    my %gid = ();  # Group ID  hash array
    my %lku = ();  # User and group ID lookup 
    foreach my $hr (@{${$urf}{user}}) {
        my $i = ${$hr}{uid};
        my $e = lc ${$hr}{email};
        next if $e !~ /^($ua_list)/i;
        foreach my $k (keys %{$hr}) {
            next if $k =~ /^(uid)$/i;
            $uid{"$i"}{$k} = ${$hr}{$k};
            $lku{uid}{$e} = $i;
        }
    }

    ${$ar}{_uid} = \%uid;
    $s->disp_param(${$ar}{_uid}) if ${$ar}{v};
    foreach my $hr (@{${$grf}{group}}) {
        my $i = ${$hr}{gid};
        my $e = lc ${$hr}{groupname};
        next if $e !~ /^($ga_list)/i;
        foreach my $k (keys %{$hr}) {
            next if $k =~ /^gid/i;
            $gid{$i}{$k} = ${$hr}{$k};
            $lku{gid}{$e} = $i;
        }
    }
    ${$ar}{_gid} = \%gid;
    $s->disp_param(${$ar}{_gid}) if ${$ar}{v};
    # build a access list
    my %ac = ();
    
    foreach my $k (split /\|/, $ua_list) { 
        $ac{uid}{$k} = (exists $lku{uid}{$k})?$lku{uid}{$k}:"";
        print "WARN: User $k does not exist.\n" if !$ac{uid}{$k} && ${$ar}{v};
    }
    foreach my $k (split /\|/, $ga_list) { 
        $ac{gid}{$k} = (exists $lku{gid}{$k})?$lku{gid}{$k}:""; 
        print "WARN: Group $k does not exist.\n" if !$ac{gid}{$k} && ${$ar}{v};
    }
    $s->disp_param(\%ac) if ${$ar}{v};
    return \%ac;
}

=head3 check_user ($cgi,$ar)

Input variables:

  $cgi - CGI object
  $ar  - Array ref containing all the parameters

Variables used or routines called: 

  disp_param  - display parameters
  get_cookies - get cookies
  get_access  - get access information

How to use:

  my $q = new CGI;
  my %cfg = (usr=>'jsmith', pwd=>'jojo');
  my @names = $q->param;
  foreach my $k (@names) { $cfg{$k} = $q->param($k) if ! exists $cfg{$k}; }
  $self->check_user($q, \%cfg);

Return: $n - status code

  0 - no user name from input nor from cookie
  1 - user name does not exists
  2 - user does not belong to any group which has granted access
  >9 - user has access to the application

A successful user authentication includes: 
1) the user has to be a valid web portal user; 
2) user's password matches
3) user has to be a authorized user or in an authorized group to use this 
application. The autorization parameters are access_users and access_groups
in the configuration file.

=cut

sub check_user {
    my $s = shift;
    my ($q, $ar) = @_;
    
    my ($usr, $pwd) = ("","");
    $usr = $ar->{user_id}	if exists $ar->{user_id};
    $ar->{user_pwd} = ""	if !$usr && exists $ar->{user_pwd};
    $pwd = $ar->{user_pwd}	if exists $ar->{user_pwd};
    return 160                  if !$pwd && $usr;

    # No user and we try to retrieve it from cookies
    my $ck1 = 'ckUID'; 		# User id
    my $ck2 = 'ckPWD'; 		# User password
    my $cr  = $s->get_cookies($q, $ar); 
    return 151   if !$usr 
        && !exists $cr->{$ck1}{$ck1} && !exists $cr->{$ck2}{$ck2}; 
    
    my ($svr,$obj); 
    $usr = $cr->{$ck1}{$ck1}  if !$usr && exists $cr->{$ck1}{$ck1};

    my ($uid, $obj_u, $s_pwd, $usr_fn, $usr_ln) = ("","","","",""); 
    $ar->{user_id} = $usr if $usr;
    return 0             if !$pwd && !$usr; 
    return 151           if !$usr;  # no user name from input nor from cookie
    return 160           if !$pwd && $usr;

    # we have user_id and password so far
    $usr =~ s/\%40/\@/g;
    # return 152 if !$uid;

    return 153 if $pwd ne $s_pwd;
        
    # So far, we have authenticated the user.
    # We need to authorize the user
    my $ua_list = ${$ar}{access_users};
       $ua_list =~ s/\s*,\s*/\|/g;
    my $ga_list = ${$ar}{access_groups};
       $ga_list =~ s/\s*,\s*/\|/g;
    my %ac = ();    # access list
    foreach my $k (split /\|/, $ua_list) { 
        my $u1 = $obj->GetUserID($k);     # get user id
        next if ! $u1;                    # did not find the user        
        my $o1 = $obj->GetUserObj($u1);   # get user object
        $ac{uid}{"$u1"} = $k;             # user id and name
    }
    foreach my $k (split /\|/, $ga_list) { 
        my $g1 = $obj->GetGroupID($k);    # get group id
        next if ! $g1;                    # did not find the group        
        my $o1 = $obj->GetGroupObj($g1);  # get group object
        $ac{gid}{"$g1"} = $k;             # group id and name
    }
    return 1000 if exists $ac{uid}{"$uid"}; 

    foreach my $g (split /,/, ${$obj_u}{GroupsList}) {
        my $go = $obj->GetGroupObj($g);
        my $gi = ${$go}{GroupID};
        return 1001 if exists $ac{gid}{"$gi"};
    }
    return 154;   # did not find in the group access
}

1;