File Coverage

blib/lib/Authorize/Rule.pm

Criterion	Covered	Total	%
statement	97	104	93.2
branch	51	64	79.6
condition	20	23	86.9
subroutine	9	11	81.8
pod	6	8	75.0
total	183	210	87.1

package Authorize::Rule;
# ABSTRACT: Rule-based authorization mechanism
$Authorize::Rule::VERSION = '0.008';
use strict;
use warnings;
use Carp 'croak';

sub new {
    my $class = shift;
    my %opts  = @_;

    defined $opts{'rules'}
        or croak 'You must provide rules';

    my $rules = $opts{'rules'};
    ref($rules) eq 'HASH'
        or croak 'attribute rules must be a hashref';

    # expand entity groups to their entities
    if ( $opts{'entity_groups'} ) {
        ref( $opts{'entity_groups'} ) eq 'HASH'
            or croak 'attribute entity_groups must be a hashref';

        foreach my $group ( keys %{ $opts{'entity_groups'} } ) {
            my $group_rules = delete $rules->{$group}
                or next;

            $rules->{$_} = $group_rules
                for @{ $opts{'entity_groups'}{$group} };
        }
    }

    # expand resource groups to their entities
    if ( $opts{'resource_groups'} ) {
        ref( $opts{'resource_groups'} ) eq 'HASH'
            or croak 'attribute resource_groups must be a hashref';

        # populate
        foreach my $entity ( keys %{$rules} ) {
            foreach my $resource ( keys %{ $rules->{$entity} } ) {
                my $in_rsrc = $opts{'resource_groups'}{$resource}
                    or next;

                $rules->{$entity}{$_} = $rules->{$entity}{$resource}
                    for @{$in_rsrc};
            }
        }

        # delete
        foreach my $entity ( keys %{$rules} ) {
            delete $rules->{$entity}{$_}
                for keys %{ $opts{'resource_groups'} };
        }
    }

    return bless {
        default => 0, # deny by default
        %opts,
    }, $class;
}

sub default {
    my $self = shift;
    @_ and croak 'default() is a ro attribute';
    return $self->{'default'};
}

sub entity_groups {
    my $self = shift;
    @_ and croak 'entity_groups() is a ro attribute';
    return $self->{'entity_groups'};
}

sub resource_groups {
    my $self = shift;
    @_ and croak 'resource_groups() is a ro attribute';
    return $self->{'resource_groups'};
}

sub rules {
    my $self = shift;
    @_ and croak 'rules() is a ro attribute';
    return $self->{'rules'};
}

sub is_allowed {
    my $self = shift;
    return $self->allowed(@_)->{'action'};
}

sub allowed {
    my $self         = shift;
    my $entity       = shift;
    my $req_resource = shift;
    my $req_params   = shift || {};
    my $default      = $self->default;
    my $rules        = $self->rules;
    my %result       = (
        entity   => $entity,
        resource => ($req_resource || ''),
        params   => $req_params,
    );

    my $perms              = $rules->{$entity} || {};
    my $all_entities_perms = $rules->{''}      || {};

    # deny entities that aren't in the rules
    $perms || $all_entities_perms
        or return { %result, action => $default };

    # the requested and default
    my $main_ruleset = $perms->{$req_resource} || [];
    my $def_ruleset  = $perms->{''}            || [];

    # perm for all the entities. Lower priority than main&def ruleset
    # we don't need to check $all_entities_perms->{''} because we have $default
    my $all_entities_ruleset = $all_entities_perms->{$req_resource} || [];

    # if neither, return default action
    @{ $main_ruleset } || @{ $def_ruleset } || @{ $all_entities_ruleset }
        or return { %result, action => $default };

    foreach my $rulesets ( $main_ruleset, $def_ruleset, $all_entities_ruleset) {
        my $ruleset_idx = 0;
        my $label;

      R_SET: foreach my $ruleset ( @{$rulesets} ) {
            if ( ! ref $ruleset ) {
                $label = $ruleset;
                next R_SET;
            }

            $ruleset_idx++;

            my $action = $self->match_ruleset( $ruleset, $req_params );

            if ( defined $action ) {
                my %full_result = (
                    %result,
                    ruleset_idx => $ruleset_idx,
                  ( label       => $label        )x!! $label,
                );

                $full_result{'action'} = ref $action eq 'CODE'      ?
                                         $action->( \%full_result ) :
                                         $action;

                return \%full_result;
            }

            undef $label;
        }
    }

    return { %result, action => $default };
}

sub match_ruleset {
    my $self       = shift;
    my $ruleset    = shift;
    my $req_params = shift;

    my ( $action, @rules ) = @{$ruleset}
        or return;

    # an empty return() is a failure to match
    # if matching of a rule succeeds, we just move to the next rule
    foreach my $rule (@rules) {
        if ( ref $rule eq 'HASH' ) {
            # check defined params by rule against requested params
          KEY: foreach my $key ( keys %{$rule} ) {
                if ( defined $rule->{$key} ) {
                    # check if key is missing
                    defined $req_params->{$key}
                        or return;
                } else {
                    # check the key exists and value is defined
                    exists $req_params->{$key}
                        and return;

                    # don't continue checking the value in this case
                    # because it's undefined
                    next KEY;
                }

                # check matching against a code reference
                if ( ref $rule->{$key} eq 'CODE' ) {
                    $req_params->{$key} eq $rule->{$key}->($req_params)
                        or return;
                } elsif ( ref $rule->{$key} eq 'Regexp' ) {
                    $req_params->{$key} =~ $rule->{$key}
                        or return;
                } elsif ( ref $rule->{$key} ) {
                    croak 'Rule keys can only be strings, regexps, or code';
                } else {
                    # check matching against a simple string
                    $req_params->{$key} eq $rule->{$key}
                        or return; # no match
                }
            }
        } elsif ( ref $rule eq 'CODE' ) {
            $rule->($req_params)
                or return;
        } elsif ( ! ref $rule ) {
            defined $req_params->{$rule}
                or return; # no match
        } else {
            croak 'Unknown rule type';
        }
    }

    return $action;
}

1;

__END__