view release on metacpan or  search on metacpan

lib/DBIx/UserDB.pm  view on Meta::CPAN

    Group A Granted + Group B Granted = User Granted
    Group A Granted + Group B Denied  = Default policy will apply
    Group A Denied  + Group B Denied  = User Denied

=item 3

A entry (target,privilege) will be lookup in the default policy. If
one is found, that policy will apply.

=item 4

Access is denied.

=back

=cut

sub allowed {
    my ( $self, $user, $target, $priv ) = @_;

    my $DB = $self->{DB};

    # Try to see if there is a policy for this particular 
    # user
    my $user_policy =
      $DB->sql_get( q{ SELECT negated FROM user_acl
		       WHERE uid = ? AND target = ? AND privilege = ? },
		    $user->{uid}, $target, $priv
		  );
    return not $user_policy->{negated} if $user_policy;

    # Now check the group in which this user is.
    # All the group policy must match for this to be returned as
    # a result. If there is a conflict, we use the default policy.
    my $groups = join ",", map { $_->{gid} } @{$user->{groups}};
    my $group_policy =
      $DB->sql_search( qq{ SELECT DISTINCT negated FROM group_acl
			   WHERE gid IN ( $groups ) AND
				 target = ? AND privilege = ?},
		       $target, $priv );
    return not $group_policy->[0]{negated} if @$group_policy == 1;

    # Use the default policy
    my $default_policy = 
      $DB->sql_get( q{ SELECT negated FROM default_acl
		       WHERE target = ? AND privilege = ? },
		    $target, $priv );

    return not $default_policy->{negated} if $default_policy;

    # Well, the default's default is to default
    return 0;
}

1;

__END__

=pod

=head1 BUGS AND LIMITATIONS

Please report bugs, suggestions, patches and thanks to
<bugs@iNsu.COM>.

Authentication is limited to clear text password authentication.

User and group data structure is restricted to single level hash.

=head1 AUTHOR

Copyright (c) 1999 Francis J. Lacoste and iNsu Innovations Inc.
All rights reserved.

This program is free software; you can redistribute it and/or modify
it under the terms as perl itself.

=head1 SEE ALSO

DBIx::SearchProfiles(3) Apache::UserDBAuthen(3) Apache::UserDBAuthz(3)

=cut