File Coverage

blib/lib/CGI/Application/Plugin/Authorization.pm
Criterion Covered Total %
statement 176 182 96.7
branch 81 88 92.0
condition 24 26 92.3
subroutine 27 28 96.4
pod 15 15 100.0
total 323 339 95.2


line stmt bran cond sub pod time code
1             package CGI::Application::Plugin::Authorization;
2              
3 11     11   540780 use strict;
  11         34  
  11         492  
4 11     11   65 use vars qw($VERSION);
  11         22  
  11         1110  
5             $VERSION = '0.07';
6              
7             our %__CONFIG;
8              
9 11     11   10241 use UNIVERSAL::require;
  11         21129  
  11         129  
10 11     11   352 use Scalar::Util;
  11         23  
  11         666  
11 11     11   113 use List::Util qw(first);
  11         24  
  11         1455  
12 11     11   62 use Carp;
  11         24  
  11         1011  
13              
14             sub import {
15 15     15   21332 my $pkg = shift;
16 15         72 my $callpkg = caller;
17             {
18 11     11   60 no strict qw(refs);
  11         19  
  11         6361  
  15         228  
19 15         40 *{ $callpkg . '::authz' }
  15         106  
20             = \&CGI::Application::Plugin::_::Authorization::authz;
21 15         33 *{ $callpkg . '::authorization' }
  15         93  
22             = \&CGI::Application::Plugin::_::Authorization::authz;
23             }
24 15 100       255 if ( !UNIVERSAL::isa( $callpkg, 'CGI::Application' ) ) {
    50          
25 1         13 warn
26             "Calling package is not a CGI::Application module so not setting up the prerun hook. If you are using \@ISA instead of 'use base', make sure it is in a BEGIN { } block, and make sure these statements appear before the plugin is loaded";
27             }
28             elsif ( !UNIVERSAL::can( $callpkg, 'add_callback' ) ) {
29 0         0 warn
30             "You are using an older version of CGI::Application that does not support callbacks, so the prerun method can not be registered automatically (Lookup 'CGI::Application CALLBACKS' in the docs for more info)";
31             }
32             else {
33 14         83 $callpkg->add_callback( prerun => \&prerun_callback );
34             }
35             }
36              
37             =head1 NAME
38              
39             CGI::Application::Plugin::Authorization - Authorization framework for
40             CGI::Application
41              
42              
43             =head1 SYNOPSIS
44              
45             use base qw(CGI::Application);
46             use CGI::Application::Plugin::Authentication;
47             use CGI::Application::Plugin::Authorization;
48              
49             # default config for runmode authorization
50             __PACKAGE__->authz->config(
51             DRIVER => [ 'HTGroup', FILE => 'htgroup' ],
52             );
53              
54             # Using a named configuration to distinguish it from
55             # the above configuration
56             __PACKAGE__->authz('dbaccess')->config(
57             DRIVER => [ 'DBI',
58             DBH => $self->dbh,
59             TABLES => ['user', 'access'],
60             JOIN_ON => 'user.id = access.user_id',
61             CONSTRAINTS => {
62             'user.name' => '__USERNAME__',
63             'access.table' => '__PARAM_1__',
64             'access.item_id' => '__PARAM_2__'
65             }
66             ],
67             );
68              
69             sub admin_runmode {
70             my $self = shift;
71              
72             # User must be in the admin group to have access to this runmode
73             return $self->authz->forbidden unless $self->authz->authorize('admin');
74              
75             # rest of the runmode
76             ...
77             }
78              
79             sub update_widget {
80             my $self = shift;
81             my $widget = $self->query->param('widget_id');
82              
83             # Can this user edit this widget in the widgets table?
84             return $self->authz->forbidden unless $self->authz('dbaccess')->authorize(widgets => $widget);
85              
86             # save changes to the widget
87             ...
88             }
89              
90             =head1 DESCRIPTION
91              
92             CGI::Application::Plugin::Authorization adds the ability to authorize users for
93             specific tasks. Once a user has been authenticated and you know who you are
94             dealing with, you can then use this plugin to control what that user has access
95             to. It imports two methods (C and C) into your
96             L module. Both of these methods are interchangeable, so you
97             should choose one and use it consistently throughout your code. Through the
98             authz method you can call all the methods of the
99             CGI::Application::Plugin::Authorization plugin.
100              
101             =head2 Named Configurations
102              
103             There could be multiple ways that you may want to authorize actions in
104             different parts of your code. These differences may conflict with each other.
105             For example you may have runmode level authorization that requires that the
106             user belongs to a certain group. But secondly, you may have row level database
107             authorization that requires that the username column of the table contains the
108             name of the current user. These configurations would conflict with each other
109             since they are authorizing using different information. To solve this you can
110             create multiple named configurations, by specifying a unique name to the
111             c method.
112              
113             __PACKAGE__->authz('dbaccess')->config(
114             DRIVER => [ 'DBI', ... ],
115             );
116             # later
117             $self->authz('dbaccess')->authorize(widgets => $widget_id);
118              
119              
120              
121             =head1 EXPORTED METHODS
122              
123             =head2 authz -and- authorization
124              
125             These methods are interchangeable and provided for users that either prefer
126             brevity, or clarity. Everything is controlled through this method call, which
127             will return a CGI::Application::Plugin::Authorization object, or just the class
128             name if called as a class method. When using the plugin, you will always first
129             call $self->authz or __PACKAGE__->authz and then the method you wish to invoke.
130             You can create multiple named authorization modules by providing a unique name
131             to the call to authz. This will allow you to handle different types of
132             authorization in your modules. For example, you could use the main
133             configuration to do runmode level authorization, and use a named configuration
134             to manage database row level authorization.
135              
136              
137             =cut
138              
139             {
140             package # Hide from PAUSE
141             CGI::Application::Plugin::_::Authorization;
142              
143             ##############################################
144             ###
145             ### authorization
146             ###
147             ##############################################
148             #
149             # Return an authorization object that can be used
150             # for managing authorization.
151             #
152             # This will return a class name if called
153             # as a class, and a singleton object
154             # if called as an object method
155             #
156             sub authz {
157 142     142   111427 my $cgiapp = shift;
158 142   100     655 my $name = shift || '__default__';
159              
160 142 100       332 if ( ref($cgiapp) ) {
161 121         567 return CGI::Application::Plugin::Authorization->instance(
162             ref($cgiapp) . '-' . $name, $cgiapp );
163             }
164             else {
165 21         205 return CGI::Application::Plugin::Authorization->instance(
166             $cgiapp . '-' . $name, $cgiapp );
167             }
168             }
169              
170             }
171              
172             package CGI::Application::Plugin::Authorization;
173              
174             =head1 METHODS
175              
176             =head2 config
177              
178             This method is used to configure the CGI::Application::Plugin::Authorization
179             module. It can be called as an object method, or as a class method.
180              
181             The following parameters are accepted:
182              
183             =over 4
184              
185             =item DRIVER
186              
187             Here you can choose which authorization module(s) you want to use to perform
188             the authorization. For simplicity, you can leave off the
189             CGI::Application::Plugin::Authorization::Driver:: part when specifying the
190             DRIVER parameter. If this module requires extra parameters, you can pass an
191             array reference that contains as the first parameter the name of the module,
192             and the required parameters as the rest of the array. You can provide multiple
193             drivers which will be used, in order, to check the permissions until a valid
194             response is received.
195              
196             DRIVER => [ 'DBI', dbh => $self->dbh ],
197              
198             - or -
199              
200             DRIVER => [
201             [ 'HTGroup', file => '.htgroup' ],
202             [ 'LDAP', binddn => '...', host => 'localhost', ... ]
203             ],
204              
205              
206             =item FORBIDDEN_RUNMODE
207              
208             Here you can specify a runmode that the user will be redirected to if they fail
209             the authorization checks.
210              
211             FORBIDDEN_RUNMODE => 'forbidden'
212              
213             =item FORBIDDEN_URL
214              
215             If your forbidden page is external to this module, then you can use this option
216             to specify a URL that the user will be redirected to when they fail the
217             authorization checks. If both FORBIDDEN_URL and FORBIDDEN_RUNMODE are
218             specified, then the latter will take precedence.
219              
220             FORBIDDEN_URL => 'http://example.com/forbidden.html'
221              
222             =item GET_USERNAME
223              
224             This option allows you to provide a method that should return us the username
225             of the currently logged in user. It will be passed the current authz objects
226             as the only parameter. This is not a required option, and can be omitted if
227             you use the Authentication plugin, or if your authentication system sets
228             $ENV{REMOTE_USER}.
229              
230             GET_USERNAME => sub { my $authz = shift; return $authz->cgiapp->my_username }
231              
232              
233             =back
234              
235             =cut
236              
237             sub config {
238 47     47 1 104 my $self = shift;
239 47         169 my $class = ref $self;
240              
241 47 100       255 die
242             "Calling config after the Authorization object has already been created"
243             if $self->{loaded};
244 46         180 my $config = $self->_config;
245              
246 46 100       122 if (@_) {
247 45         57 my $props;
248 45 100       414 if ( ref( $_[0] ) eq 'HASH' ) {
249 2         3 my $rthash = %{ $_[0] };
  2         9  
250 2         9 $props = CGI::Application->_cap_hash( $_[0] );
251             }
252             else {
253 43         304 $props = CGI::Application->_cap_hash( {@_} );
254             }
255              
256             # Check for DRIVER
257 45 100       859 if ( defined $props->{DRIVER} ) {
258 36 100 100     305 croak
259             "authz config error: parameter DRIVER is not a string or arrayref"
260             if ref $props->{DRIVER}
261             && Scalar::Util::reftype( $props->{DRIVER} ) ne 'ARRAY';
262 35         125 $config->{DRIVER} = delete $props->{DRIVER};
263             # We will accept a string, or an arrayref of options, but what we
264             # really want is an array of arrayrefs of options, so that we can
265             # support multiple drivers each with their own custom options
266 11     11   74 no warnings qw(uninitialized);
  11         22  
  11         24464  
267 35 100       164 $config->{DRIVER} = [ $config->{DRIVER} ]
268             if Scalar::Util::reftype( $config->{DRIVER} ) ne 'ARRAY';
269 35 100       228 $config->{DRIVER} = [ $config->{DRIVER} ]
270             if Scalar::Util::reftype( $config->{DRIVER}->[0] ) ne 'ARRAY';
271             }
272              
273             # Check for FORBIDDEN_RUNMODE
274 44 100       137 if ( defined $props->{FORBIDDEN_RUNMODE} ) {
275 4 100       30 croak
276             "authz config error: parameter FORBIDDEN_RUNMODE is not a string"
277             if ref $props->{FORBIDDEN_RUNMODE};
278 3         11 $config->{FORBIDDEN_RUNMODE} = delete $props->{FORBIDDEN_RUNMODE};
279             }
280              
281             # Check for FORBIDDEN_URL
282 43 100       133 if ( defined $props->{FORBIDDEN_URL} ) {
283 7 50       20 carp
284             "authz config warning: parameter FORBIDDEN_URL ignored since we already have FORBIDDEN_RUNMODE"
285             if $config->{FORBIDDEN_RUNMODE};
286 7 100       29 croak
287             "authz config error: parameter FORBIDDEN_URL is not a string"
288             if ref $props->{FORBIDDEN_URL};
289 6         18 $config->{FORBIDDEN_URL} = delete $props->{FORBIDDEN_URL};
290             }
291              
292             # Check for GET_USERNAME
293 42 100       120 if ( defined $props->{GET_USERNAME} ) {
294 10 100       49 croak
295             "authz config error: parameter GET_USERNAME is not a CODE reference"
296             if ref $props->{GET_USERNAME} ne 'CODE';
297 9         26 $config->{GET_USERNAME} = delete $props->{GET_USERNAME};
298             }
299              
300             # If there are still entries left in $props then they are invalid
301 41 100       230 croak "Invalid option(s) ("
302             . join( ', ', keys %$props )
303             . ") passed to config"
304             if %$props;
305             }
306             }
307              
308             =head2 authz_runmodes
309              
310             This method takes a list of runmodes that are to be authorized, and
311             the authorization rules for said runmodes. If a user tries to access
312             one of these runmodes, then they will be redirected to the forbidden
313             page unless authorization is granted.
314              
315             The runmode names can be simple strings, regular expressions, coderefs
316             (which are passed the name of the runmode as their only parameter), or
317             special directives that start with a colon.
318              
319             The authorization rules can be simple strings representing the name of
320             the group that the user must be a member of, as a list-ref of group
321             names (of which the user only has to be a member of B
322             groups>, or as a code-ref that will be called (with I parameters).
323              
324             This method is cumulative, so if it is called multiple times, the new
325             values are appended to the list of existing entries. It returns a list
326             containing all of the entries that have been configured thus far.
327              
328             B compatibility with the interface as was defined in 0.06 B
329             preserved. 0.06 allowed for runmodes to be passed in as a list-ref of
330             two-element lists to specify authorization rules. Although this
331             interface is supported, the extra list-refs aren't necessary.
332              
333             =over 4
334              
335             =item :all - All runmodes in this module will require authorization
336              
337             =back
338              
339             # match all runmodes
340             __PACKAGE__->authz->authz_runmodes(
341             ':all' => 'admin',
342             );
343              
344             # only protect runmodes one and two
345             __PACKAGE__->authz->authz_runmodes(
346             one => 'admin',
347             two => 'admin',
348             );
349              
350             # protect only runmodes that start with auth_
351             __PACKAGE__->authz->authz_runmodes(
352             qr/^authz_/ => 'admin',
353             );
354              
355             # protect all runmodes that *do not* start with public_
356             __PACKAGE__->authz->authz_runmodes(
357             qr/^(?!public_)/ => 'admin',
358             );
359              
360             # preserve the interface from 0.06:
361             __PACKAGE__->authz->authz_runmodes(
362             [':all' => 'admin'],
363             );
364              
365             =cut
366              
367             sub authz_runmodes {
368 34     34 1 49 my $self = shift;
369 34         71 my $config = $self->_config;
370              
371 34   100     126 $config->{AUTHZ_RUNMODES} ||= [];
372              
373 34         90 while (@_) {
374 33         33 my ($rm, $group);
375              
376             # extract next runmode/authz rule from args
377 33 100       72 if (ref($_[0]) eq 'ARRAY') {
378             # 0.06 interface; list-ref
379 3         4 my $rule = shift @_;
380 3         4 ($rm, $group) = @{$rule};
  3         10  
381             }
382             else {
383             # new interface; list
384 30         46 $rm = shift @_;
385 30         46 $group = shift @_;
386             }
387              
388             # add authz rule to our config
389 33         39 push( @{$config->{AUTHZ_RUNMODES}}, [$rm, $group] );
  33         143  
390             }
391              
392 34         39 return @{$config->{AUTHZ_RUNMODES}};
  34         125  
393             }
394              
395             =head2 is_authz_runmode
396              
397             This method accepts the name of a runmode, and if that runmode requires
398             authorization (ie the user needs to be a member of a particular group
399             or has to satisfy some other authorization rule) then this method
400             returns the corresponding authorization rule which must be satisfied
401             (which could be either a scalar, a list-ref, or a code-ref, depending
402             on how the rules were defined).
403              
404             =cut
405              
406             sub is_authz_runmode {
407 17     17 1 100 my $self = shift;
408 17         26 my $runmode = shift;
409              
410 17         46 foreach my $runmode_info ($self->authz_runmodes) {
411 14         37 my ($runmode_test, $rule) = @$runmode_info;
412 14 100 66     49 if (overload::StrVal($runmode_test) =~ /^Regexp=/) {
    100          
    100          
413             # We were passed a regular expression
414 2 50       30 return $rule if $runmode =~ $runmode_test;
415             } elsif (ref $runmode_test && ref $runmode_test eq 'CODE') {
416             # We were passed a code reference
417 2 50       23 return $rule if $runmode_test->($runmode);
418             } elsif ($runmode_test eq ':all') {
419             # all runmodes are protected
420 2         20 return $rule;
421             } else {
422             # assume we were passed a string
423 8 50       120 return $rule if $runmode eq $runmode_test;
424             }
425             }
426              
427 3         16 return undef;
428             }
429              
430             =head2 new
431              
432             This method creates a new L object.
433             It requires as it's only parameter a L object. This method
434             should never be called directly, since the C method that is imported
435             into the L module will take care of creating the
436             L object when it is required.
437              
438             =cut
439              
440             sub new {
441 68     68 1 101 my $class = shift;
442 68         93 my $name = shift;
443 68         96 my $cgiapp = shift;
444 68         118 my $self = {};
445              
446 68         256 bless $self, $class;
447 68         265 $self->{name} = $name;
448 68         139 $self->{cgiapp} = $cgiapp;
449 68 100       317 Scalar::Util::weaken( $self->{cgiapp} )
450             if ref $self->{cgiapp}; # weaken circular reference
451              
452 68         319 return $self;
453             }
454              
455             =head2 instance
456              
457             This method works the same way as C, except that it returns the same
458             Authorization object for the duration of the request. This method should never
459             be called directly, since the C method that is imported into the
460             L module will take care of creating the
461             L object when it is required.
462              
463             =cut
464              
465             sub instance {
466 143     143 1 1910 my $class = shift;
467 143   100     376 my $name = shift ||'';
468 143         193 my $cgiapp = shift;
469 143 100 100     1029 die
470             "CGI::Application::Plugin::Authorization->instance must be called with a CGI::Application object or class name"
471             unless defined $cgiapp
472             && UNIVERSAL::isa( $cgiapp, 'CGI::Application' );
473              
474 141 100       329 if ( ref $cgiapp ) {
475             # being called from a CGI::Application object
476 120 100       549 $cgiapp->{__CAP_AUTHORIZATION_INSTANCE}->{$name}
477             = $class->new( $name, $cgiapp )
478             unless defined $cgiapp->{__CAP_AUTHORIZATION_INSTANCE}->{$name};
479 120         731 return $cgiapp->{__CAP_AUTHORIZATION_INSTANCE}->{$name};
480             }
481             else {
482             # being called from a CGI::Application class
483 21         76 return $class->new( $name, $cgiapp );
484             }
485             }
486              
487             =head2 authorize
488              
489             This method will test to see if the current user has access to the given
490             resource. It will take the given parameters and test them against the DRIVER
491             classes that have been configured. A true return value means the user should
492             have access to the given resource.
493              
494             # is the current user in the admin group
495             if ($self->authz->authorize('admingroup')) {
496             # perform an admin action
497             }
498              
499             =cut
500              
501             sub authorize {
502 38     38 1 56 my $self = shift;
503 38         81 my @params = @_;
504              
505 38         101 foreach my $driver ( $self->drivers ) {
506 36 100       148 return 1 if $driver->authorize(@params);
507             }
508 19         61 return 0;
509             }
510              
511             =head2 username
512              
513             This method will return the name of the currently logged in user. It uses
514             three different methods to figure out the username:
515              
516             =over 4
517              
518             =item GET_USERNAME option
519              
520             Use the subroutine provided by the GET_USERNAME option to figure out the
521             current username
522              
523             =item CGI::Application::Plugin::Authentication
524              
525             See if the L plugin is being used,
526             and retrieve the username through this plugin
527              
528             =item REMOTE_USER
529              
530             See if the REMOTE_USER environment variable is set and use that value
531              
532             =back
533              
534             =cut
535              
536             sub username {
537 39     39 1 60 my $self = shift;
538 39         162 my $config = $self->_config;
539              
540 39 100       128 if ( $config->{GET_USERNAME} ) {
    100          
541 17         54 return $config->{GET_USERNAME}->($self);
542             }
543             elsif ( $self->cgiapp->can('authen') ) {
544 1         5 return $self->cgiapp->authen->username;
545             }
546             else {
547 21         110 return $ENV{REMOTE_USER};
548             }
549             }
550              
551             =head2 drivers
552              
553             This method will return a list of driver objects that are used for
554             this authorization instance.
555              
556             =cut
557              
558             sub drivers {
559 42     42 1 422 my $self = shift;
560              
561 42 100       130 if ( !$self->{drivers} ) {
562 27         63 my $config = $self->_config;
563              
564             # Fetch the configuration parameters for the driver(s)
565 27 100       90 my $driver_configs
566             = defined $config->{DRIVER} ? $config->{DRIVER} : [ ['Dummy'] ];
567              
568 27         63 foreach my $driver_config (@$driver_configs) {
569 28         65 my ( $drivername, @params ) = @$driver_config;
570             # Load the the class for this driver
571 28   100     130 my $driver_class = _find_delegate_class(
572             'CGI::Application::Plugin::Authorization::Driver::'
573             . $drivername, $drivername
574             )
575             || die "Driver " . $drivername . " can not be found";
576              
577             # Create the driver object
578 27   100     1520 my $driver = $driver_class->new( $self, @params )
579             || die "Could not create new $driver_class object";
580 26         41 push @{ $self->{drivers} }, $driver;
  26         132  
581             }
582 25         74 $self->{loaded} = 1;
583             }
584              
585 40         71 my $drivers = $self->{drivers};
586 40         161 return @$drivers[ 0 .. $#$drivers ];
587             }
588              
589             =head2 cgiapp
590              
591             This will return the underlying CGI::Application object.
592              
593             =cut
594              
595             sub cgiapp {
596 228     228 1 850 return $_[0]->{cgiapp};
597             }
598              
599              
600             =head2 setup_runmodes
601              
602             This method is called during the prerun stage to register some custom
603             runmodes that the Authentication plugin requires in order to function.
604              
605             =cut
606              
607             sub setup_runmodes {
608 17     17 1 112 my $self = shift;
609 17         36 $self->cgiapp->run_modes( authz_dummy_redirect => \&authz_dummy_redirect );
610 17         367 $self->cgiapp->run_modes( authz_forbidden => \&authz_forbidden );
611 17         300 return;
612             }
613              
614             =head1 CGI::Application CALLBACKS
615              
616             We'll automatically add the C run mode if you are using
617             CGI::Application 4.0 or greater.
618              
619             If you are using an older version of CGI::Application you will need to add it yourself.
620              
621             sub cgiapp_prerun {
622             my $self = shift;
623              
624             $self->run_modes( authz_forbidden => \&CGI::Application::Plugin::Authorization::authz_forbidden, );
625             }
626              
627             =cut
628              
629             =head2 prerun_callback
630              
631             This method is a CGI::Application prerun callback that will be
632             automatically registered for you if you are using CGI::Application
633             4.0 or greater. If you are using an older version of CGI::Application
634             you will have to create your own cgiapp_prerun method and make sure you
635             call this method from there.
636              
637             sub cgiapp_prerun {
638             my $self = shift;
639              
640             $self->CGI::Application::Plugin::Authorization::prerun_callback();
641             }
642              
643             =cut
644              
645             sub prerun_callback {
646 17     17 1 51239 my $self = shift;
647 17         46 my $authz = $self->authz;
648 17         33 my $rule = undef;
649              
650             # setup the default login and logout runmodes
651 17         44 $authz->setup_runmodes;
652              
653 17 100       77 if ($rule = $authz->is_authz_runmode($self->get_current_runmode)) {
654             # This runmode requires authorization
655             my $authz_ok = ref($rule) eq 'CODE' ? $rule->()
656 14 100   9   90 : ref($rule) eq 'ARRAY' ? first { $self->authz->authorize($_) } @{$rule}
  9 100       23  
  2         18  
657             : $self->authz->authorize($rule);
658 14 100       171 return $self->authz->redirect_to_forbidden
659             unless ($authz_ok);
660             }
661             }
662              
663             =head2 redirect_to_forbidden
664              
665             This method is be called during the prerun stage if
666             the current user is not authorized, and they are trying to
667             access an authz runmode. It will redirect to the page
668             that has been configured as the forbidden page, based on the value
669             of FORBIDDEN_RUNMODE or FORBIDDEN_URL If nothing is configured
670             then the default forbidden page will be used.
671              
672             =cut
673              
674             sub redirect_to_forbidden {
675 7     7 1 12 my $self = shift;
676 7         13 my $cgiapp = $self->cgiapp;
677 7         15 my $config = $self->_config;
678              
679 7 50       26 if ($config->{FORBIDDEN_RUNMODE}) {
    50          
680 0         0 $cgiapp->prerun_mode($config->{FORBIDDEN_RUNMODE});
681             } elsif ($config->{FORBIDDEN_URL}) {
682 0         0 $cgiapp->header_add(-location => $config->{FORBIDDEN_URL});
683 0         0 $cgiapp->header_type('redirect');
684 0         0 $cgiapp->prerun_mode('authz_dummy_redirect');
685             } else {
686 7         21 $cgiapp->prerun_mode('authz_forbidden');
687             }
688             }
689              
690             =head2 forbidden
691              
692             This will return a forbidden page. It checks the configuration to see if there
693             is a custom runmode or URL to redirect to, otherwise it calls the builtin
694             authz_forbidden runmode.
695              
696             =cut
697              
698             sub forbidden {
699 3     3 1 5 my $self = shift;
700 3         8 my $cgiapp = $self->cgiapp;
701 3         7 my $config = $self->_config;
702              
703 3 100       16 if ( $config->{FORBIDDEN_RUNMODE} ) {
    100          
704 1         4 my $runmode = $config->{FORBIDDEN_RUNMODE};
705 1         5 return $cgiapp->$runmode();
706             }
707             elsif ( $config->{FORBIDDEN_URL} ) {
708 1         9 $cgiapp->header_add( -location => $config->{FORBIDDEN_URL} );
709 1         43 $cgiapp->header_type('redirect');
710 1         14 return;
711             }
712             else {
713 1         3 return authz_forbidden( $self->cgiapp );
714             }
715             }
716              
717             =head1 CGI::Application RUNMODES
718              
719             =head2 authz_forbidden
720              
721             This runmode is provided if you do not want to create your own forbidden
722             runmode. It will display a simple error page to the user.
723              
724             =cut
725              
726             sub authz_forbidden {
727 8     8 1 533 my $self = shift;
728 8         26 my $q = $self->query;
729              
730 8         1084 my $html = join(
731             "\n",
732             CGI::start_html(
733             -title => 'Forbidden',
734             #-style => { -code => $self->auth->styles },
735             ),
736             CGI::h2('Forbidden'),
737             CGI::p('You do not have permission to perform that action'),
738             CGI::end_html(),
739             );
740              
741 8         13241 return $html;
742             }
743              
744             =head2 authz_dummy_redirect
745              
746             This runmode is provided for convenience when an external redirect needs
747             to be done. It just returns an empty string.
748              
749             =cut
750              
751             sub authz_dummy_redirect {
752 0     0 1 0 return '';
753             }
754              
755             ###
756             ### Helper methods
757             ###
758              
759             sub _find_delegate_class {
760 28     28   58 foreach my $class (@_) {
761 30 100       224 $class->require && return $class;
762             }
763 1         26 return;
764             }
765              
766             sub _config {
767 156     156   206 my $self = shift;
768 156         250 my $name = $self->{name};
769 156         177 my $config;
770 156 100       346 if ( ref $self->cgiapp ) {
771 136   100     621 $config = $self->{__CAP_AUTHORIZATION_CONFIG} ||= $__CONFIG{$name}
      66        
772             || {};
773             }
774             else {
775 20   100     113 $__CONFIG{$name} ||= {};
776 20         40 $config = $__CONFIG{$name};
777             }
778 156         350 return $config;
779             }
780              
781             =head1 EXAMPLE
782              
783             In a CGI::Application module:
784              
785             package MyCGIApp;
786              
787             use base qw(CGI::Application);
788             use CGI::Application::Plugin::AutoRunmode;
789             use CGI::Application::Plugin::Authentication;
790             use CGI::Application::Plugin::Authorization;
791            
792             # Configure Authentication
793             MyCGIApp->authen->config(
794             DRIVER => 'Dummy',
795             );
796             MyCGIApp->authen->protected_runmodes(qr/^admin_/);
797              
798             # Configure Authorization (manages runmode authorization)
799             MyCGIApp->authz->config(
800             DRIVER => [ 'DBI',
801             DBH => $self->dbh,
802             TABLES => ['user', 'usergroup', 'group'],
803             JOIN_ON => 'user.id = usergroup.user_id AND usergroup.group_id = group.id',
804             CONSTRAINTS => {
805             'user.name' => '__USERNAME__',
806             'group.name' => '__GROUP__',
807             }
808             ],
809             );
810             MyCGIApp->authz->authz_runmodes(
811             [a_runmode => 'a_group'],
812             [qr/^admin_/ => 'admin'],
813             [':all' => 'all_group'],
814             [sub {my $rm = shift; return ($rm eq "dangerous_rm")} => 'super_group'],
815             );
816              
817             # Configure second Authorization module using a named configuration
818             __PACKAGE__->authz('dbaccess')->config(
819             DRIVER => [ 'DBI',
820             DBH => $self->dbh,
821             TABLES => ['user', 'access'],
822             JOIN_ON => 'user.id = access.user_id',
823             CONSTRAINTS => {
824             'user.name' => '__USERNAME__',
825             'access.table' => '__PARAM_1__',
826             'access.item_id' => '__PARAM_2__'
827             }
828             ],
829             );
830              
831             sub start : Runmode {
832             my $self = shift;
833              
834             }
835              
836             sub admin_one : Runmode {
837             my $self = shift;
838             # The user will only get here if they are logged in and
839             # belong to the admin group
840              
841             }
842              
843             sub admin_widgets : Runmode {
844             my $self = shift;
845             # The user will only get here if they are logged in and
846             # belong to the admin group
847              
848             # Can this user edit this widget in the widgets table?
849             my $widget_id = $self->query->param('widget_id');
850             return $self->authz->forbidden unless $self->authz('dbaccess')->authorize(widgets => $widget_id);
851            
852             }
853              
854              
855             =head1 TODO
856              
857             The module is definately in a usable state, but there are still some parts
858             missing that I would like to add in:
859              
860             =over 4
861              
862             =item provide easy methods for authorizing runmode access automatically
863              
864             =item allow subroutine attributes to configure authorization for a runmode
865              
866             =item write a tutorial/cookbook to include with the docs
867              
868             =back
869              
870              
871             =head1 BUGS
872              
873             This is alpha software and as such, the features and interface are subject to
874             change. So please check the Changes file when upgrading.
875              
876              
877             =head1 SEE ALSO
878              
879             L, L, perl(1)
880              
881              
882             =head1 AUTHOR
883              
884             Cees Hek
885              
886             =head1 CREDITS
887              
888             Thanks to SiteSuite (http://www.sitesuite.com.au) for funding the development
889             of this plugin and for releasing it to the world.
890              
891              
892             =head1 LICENCE AND COPYRIGHT
893              
894             Copyright (c) 2005, SiteSuite. All rights reserved.
895              
896             This module is free software; you can redistribute it and/or modify it under
897             the same terms as Perl itself.
898              
899             =head1 DISCLAIMER OF WARRANTY
900              
901             BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE
902             SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE
903             STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE
904             SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED,
905             INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
906             FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND
907             PERFORMANCE OF THE SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE,
908             YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION.
909              
910             IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY
911             COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE
912             SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE LIABLE TO YOU FOR DAMAGES,
913             INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING
914             OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (INCLUDING BUT NOT LIMITED TO
915             LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR
916             THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE),
917             EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
918             DAMAGES.
919              
920             =cut
921              
922             1;