CGI-AppBuilder-Login

 view release on metacpan or  search on metacpan

CGI-AppBuilder-Login-0.01.readme  view on Meta::CPAN

      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.

   check_user ($cgi,$ar)
    Input variables:

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

Login.pm  view on Meta::CPAN

  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) = @_;
    

Login.pm  view on Meta::CPAN

    # 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

Login.pm  view on Meta::CPAN

    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;

README  view on Meta::CPAN

      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.

   check_user ($cgi,$ar)
    Input variables:

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