/usr/share/perl5/Catalyst/Plugin/Authorization/ACL/Engine.pm is in libcatalyst-plugin-authorization-acl-perl 0.16-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316 317 318 319 320 321 322 323 324 325 326 327 328 329 330 331 332 333 334 335 336 337 338 339 340 341 342 343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 | package Catalyst::Plugin::Authorization::ACL::Engine;
BEGIN {
$Catalyst::Plugin::Authorization::ACL::Engine::AUTHORITY = 'cpan:RKITOVER';
}
$Catalyst::Plugin::Authorization::ACL::Engine::VERSION = '0.16';
use namespace::autoclean;
use Moose;
extends qw/Moose::Object Exporter/;
# I heart stevan
use Class::Throwable;
use Tree::Simple;
use Tree::Simple::Visitor::FindByPath;
use Tree::Simple::Visitor::GetAllDescendents;
use Carp qw/croak/;
use List::Util 'first';
has app => (is => 'rw');
has actions => (is => 'ro', isa => 'HashRef', default => sub { {} });
has _app_actions_tree => (is => 'ro', isa => 'Tree::Simple', lazy_build => 1);
our $DENIED = bless {}, __PACKAGE__ . "::Denied";
our $ALLOWED = bless {}, __PACKAGE__ . "::Allowed";
our @EXPORT_OK = qw/$DENIED $ALLOWED/;
sub BUILDARGS {
my ($self, $c) = @_;
return +{ app => $c };
}
sub _build__app_actions_tree {
my $self = shift;
my $root = Tree::Simple->new('/', Tree::Simple->ROOT);
my $app = $self->app;
my @actions = grep defined, map {
my $controller = $_;
map $controller->action_for($_->name), $controller->get_action_methods
} grep $_->isa('Catalyst::Controller'), values %{ $app->components };
for my $action (@actions) {
my @path = split '/', $action->reverse;
my $name = pop @path;
if (@path) {
my $by_path = Tree::Simple::Visitor::FindByPath->new;
$by_path->setSearchPath(@path);
$root->accept($by_path);
if (my $namespace_node = $by_path->getResult) {
$namespace_node->addChild(Tree::Simple->new($action));
next;
}
}
my $node = $root;
for my $el (@path) {
if (my $found = first { $_->getNodeValue eq $el }
@{ $node->getAllChildren }) {
$node = $found;
}
else {
$node = Tree::Simple->new($el, $node);
}
}
$node->addChild(Tree::Simple->new($action));
}
return $root;
}
sub add_deny {
my ( $self, $spec, $condition ) = @_;
my $test = $self->fudge_condition($condition);
$self->add_rule(
$spec,
sub {
my $c = shift;
die $DENIED unless $c->$test(@_);
},
);
}
sub add_allow {
my ( $self, $spec, $condition ) = @_;
my $test = $self->fudge_condition($condition);
$self->add_rule(
$spec,
sub {
my $c = shift;
die $ALLOWED if $c->$test(@_);
},
);
}
sub fudge_condition {
my ( $self, $condition ) = @_;
# make almost anything into a code ref/method name
if (!defined($condition)
# no warnings
or $condition eq '1'
or $condition eq '0'
or $condition eq "" )
{
return sub { $condition };
}
elsif ( my $reftype = ref $condition ) {
$reftype eq "CODE" and return $condition;
# if it's not a code ref and it's a ref, we only know
# how to deal with it if it's an array of roles
$reftype ne "ARRAY"
and die "Can't interpret '$condition' as an ACL condition";
# but to check roles we need the appropriate plugin
$self->app->isa("Catalyst::Plugin::Authorization::Roles")
or die "Can't use role list as an ACL condition unless "
. "the Authorization::Roles plugin is also loaded.";
# return a test that will check for the roles
return sub {
my $c = shift;
$c->check_user_roles(@$condition);
};
}
elsif ( $self->app->can($condition) ) {
return $condition; # just a method name
}
else {
croak "Can't use '$condition' as an ACL "
. "condition unless \$c->can('$condition').";
}
}
sub add_rule {
my ( $self, $path, $rule, $filter ) = @_;
$filter ||= sub { $_[0]->name !~ /^_/ }; # internal actions are not ACL'd
my $d = $self->app->dispatcher;
my $cxt = _pretty_caller();
$self->{cxt_info}{$rule} = $cxt;
my ( $ns, $name ) = $path =~ m#^/?(.*?)/?([^/]+)$#;
if ( my $action = $d->get_action( $name, $ns ) ) {
$self->app->log->debug(
"Adding ACL rule from $cxt to the action $path with sort index 0")
if $self->app->debug;
$self->append_rule_to_action( $action, 0, $rule, $cxt );
}
else {
my @path = grep { $_ ne "" } split( "/", $path );
my $tree = $self->_app_actions_tree;
my $subtree = @path
? do {
my $by_path = Tree::Simple::Visitor::FindByPath->new;
$by_path->setSearchPath(@path);
$tree->accept($by_path);
$by_path->getResult
|| Catalyst::Exception->throw(
"The path '$path' does not exist (traversal hit a dead end "
. "at: @{[ map { $_->getNodeValue } $by_path->getResults ]})"
);
}
: $tree;
my $root_depth = $subtree->getDepth;
my $descendents = Tree::Simple::Visitor::GetAllDescendents->new;
$descendents->setNodeFilter( sub { $_[0] } ); #
$subtree->accept($descendents);
$self->app->log->debug(
"Adding ACL rule from $cxt to all the actions under $path")
if $self->app->debug;
foreach my $action_node ( $descendents->getResults ) {
next unless $action_node->isLeaf;
my ( $action, $depth ) =
( $action_node->getNodeValue, $action_node->getDepth );
next unless $filter->($action);
my $sort_index =
( $depth - $root_depth )
; # how far an action is from the origin of the ACL
$self->app->log->debug("... $action at sort index $sort_index")
if $self->app->debug;
$self->append_rule_to_action( $action, $sort_index, $rule, $cxt,
);
}
}
}
sub get_cxt_for_rule {
my ( $self, $rule ) = @_;
$self->{cxt_info}{$rule};
}
sub append_rule_to_action {
my ( $self, $action, $sort_index, $rule, $cxt ) = @_;
$sort_index = 0 if $sort_index < 0;
push @{ $self->get_action_data($action)->{rules_radix}[$sort_index] ||=
[] }, $rule;
}
sub get_action_data {
my ( $self, $action ) = @_;
$self->actions->{ $action->reverse } ||= { action => $action };
}
sub get_rules {
my ( $self, $action ) = @_;
map { $_ ? @$_ : () }
@{ ( $self->get_action_data($action) || return () )->{rules_radix} };
}
sub check_action_rules {
my ( $self, $c, $action ) = @_;
my $last_rule;
my $rule_exception;
{
local $SIG{__DIE__}; # nobody messes with us!
local $@;
eval {
foreach my $rule ( $self->get_rules($action) )
{
$c->log->debug( "running ACL rule $rule defined at "
. $self->get_cxt_for_rule($rule)
. " on $action" )
if $c->debug;
$last_rule = $rule;
$c->$rule($action);
}
};
$rule_exception = $@;
}
if ($rule_exception) {
if ( ref $rule_exception and $rule_exception == $DENIED ) {
die "Access to $action denied by rule $last_rule (defined at "
. $self->get_cxt_for_rule($last_rule) . ").\n";
}
elsif ( ref $rule_exception and $rule_exception == $ALLOWED ) {
$c->log->debug(
"Access to $action allowed by rule $last_rule (defined at "
. $self->get_cxt_for_rule($last_rule)
. ")" )
if $c->debug;
return;
}
else {
# unknown exception
# FIXME - add context (the user should know what rule
# generated the exception, and where it was added)
Class::Throwable->throw(
"An error occurred while evaluating ACL rules.", $rule_exception );
}
}
# no rules means allow by default
}
sub _pretty_caller {
my ( undef, $file, $line ) = _find_caller();
return "$file line $line";
}
sub _find_caller {
for ( my $i = 2 ; ; $i++ ) {
my @caller = caller($i) or die "Error determining caller";
return @caller if $caller[0] !~ /^Catalyst::Plugin::Authorization::ACL/;
}
}
__PACKAGE__->meta->make_immutable;
__PACKAGE__;
__END__
=pod
=head1 NAME
Catalyst::Plugin::Authorization::ACL::Engine - The backend that computes ACL
checks for L<Catalyst::Plugin::Authorization::ACL>.
=head1 SYNOPSIS
# internal
=head1 METHODS
=over 4
=item new $app
Create a new rule engine for $app
=item add_allow $cond
=item add_deny $cond
fudge C<$cond>, make cond into a rule, and C<add_rule>
=item add_rule $path, $rule
Add rule to all actions under $path
=item append_rule_to_action $action, $index, $rule, $cxt
Append C<$rule> to C<$action> in slot C<$index>, and store context info C<$cxt>
for error reporting.
=item check_action_rules $action
Evaluate the rules for an action
=item fudge_condition $thingy
Converts a C<$thingy> into a subref, for DWIM goodness. See the main ACL docs.
=item get_action_data $action
=item get_cxt_for_rule $rule
=item get_rules
=back
=head1 DESCRIPTION
This is the engine which executes the access control checks for
L<Catalyst::Plugin::Authorization::ACL>. Please use that module directly.
=head1 TODO
* external uris -> private paths
=cut
|