File Coverage

blib/lib/CGI/Application/Plugin/Authorization/Driver/DBI.pm
Criterion Covered Total %
statement 9 56 16.0
branch 0 34 0.0
condition 0 10 0.0
subroutine 3 4 75.0
pod 1 1 100.0
total 13 105 12.3


line stmt bran cond sub pod time code
1             package CGI::Application::Plugin::Authorization::Driver::DBI;
2              
3 1     1   6901 use strict;
  1         3  
  1         43  
4 1     1   6 use warnings;
  1         2  
  1         41  
5              
6 1     1   6 use base qw(CGI::Application::Plugin::Authorization::Driver);
  1         2  
  1         827  
7              
8             =head1 NAME
9              
10             CGI::Application::Plugin::Authorization::Driver::DBI - DBI Authorization driver
11              
12              
13             =head1 SYNOPSIS
14              
15             use base qw(CGI::Application);
16             use CGI::Application::Plugin::Authorization;
17              
18             # Simple task based authentication
19             __PACKAGE__->authz->config(
20             DRIVER => [ 'DBI',
21             TABLES => ['account', 'task'],
22             JOIN_ON => 'account.id = task.accountid',
23             USERNAME => 'account.name',
24             CONSTRAINTS => {
25             'task.name' => '__PARAM_1__',
26             }
27             ],
28             );
29             if ($self->authz->authorize('editfoo') {
30             # User is allowed access if it can 'editfoo'
31             }
32              
33              
34             =head1 DESCRIPTION
35              
36             This Authorization driver uses the DBI module to allow you to gather
37             authorization information from any database for which there is a DBD module.
38             You can either provide an active database handle, or provide the parameters
39             necesary to connect to the database.
40              
41             =head2 DBH
42              
43             The DBI database handle to use. Defaults to C<$self-Edbh()>, which is provided and configured
44             through L
45              
46             When describing the database structure you have two options:
47              
48             =over 4
49              
50             =item TABLE(S), JOIN_ON, USERNAME and CONSTRAINTS:
51              
52             Use these values to describe the table structure, and an sql statement
53             will be automatically generated to query the database
54              
55             =item SQL:
56              
57             just provide one SQL parameters that gives a complete sql statement that will
58             be used to query the database
59              
60             =back
61              
62             Following is a description of all the avaliable parameters:
63              
64             =head2 TABLE(S)
65              
66             Provide either a single table name, or an array of table names. You can give
67             the table names aliases which can be referenced in later columns.
68              
69             TABLE => 'group',
70              
71             - or -
72              
73             TABLES => ['user U', 'group G'],
74              
75              
76             =head2 JOIN_ON
77              
78             If you have specified multiple tables, then you need to provide an SQL
79             expression that can be used to join those tables.
80              
81             JOIN_ON => 'user.id = group.userid',
82              
83             - or -
84              
85             JOIN_ON => 'U.id = G.userid',
86              
87              
88             =head2 USERNAME
89              
90             This should be set to the column name that contains the username. This column
91             will be compared against the currently logged in user.
92              
93             USERNAME => 'name'
94              
95             - or -
96              
97             USERNAME => 'U.name'
98              
99              
100             =head2 CONSTRAINTS
101              
102             Constraints are used to restrict the database query against the options that
103             are passed to the C method. In the common case, you will check these
104             parameters against a group permission table, although there is no limit to the
105             number of parameters that can be used. Each constraint can be set to a static
106             value, or it can be set to '__PARAM_n__' where 'n' is the position of the
107             parameter that is passed in to the C method.
108              
109             CONSTRAINTS => {
110             'user.active' => 't',
111             'group.type' => '__PARAM_1__',
112             'group.name' => '__PARAM_2__',
113             }
114              
115              
116             =head2 SQL
117              
118             If you need to perform a complex query that can not be defined by the above
119             syntax, then you can provide your own SQL statment where the first placeholder
120             is used to fill in the username, and the rest of the placeholders are filled in
121             using the parameters passed to the authorize method.
122              
123             SQL => 'SELECT count(*)
124             FROM account
125             LEFT JOIN ip ON (account.id = ip.accountid)
126             LEFT JOIN task ON (account.id = task.accountid)
127             WHERE account.name = ?
128             AND (ip.address >> inet ? OR task.name = ?)
129             ',
130              
131              
132             =head1 EXAMPLE
133              
134             #
135             # Example table structure (for PostgreSQL):
136             #
137             CREATE TABLE account (
138             id SERIAL NOT NULL PRIMARY KEY,
139             name VARCHAR(50) NOT NULL
140             );
141             CREATE TABLE task (
142             id SERIAL NOT NULL PRIMARY KEY,
143             accountid INTEGER NOT NULL REFERENCES account(id),
144             name VARCHAR(50) NOT NULL
145             );
146             CREATE TABLE ip (
147             id SERIAL NOT NULL PRIMARY KEY,
148             accountid INTEGER NOT NULL REFERENCES account(id),
149             address INET NOT NULL
150             );
151             INSERT INTO account (name) VALUES ('testuser');
152             INSERT INTO task (accountid, name) VALUES (1, 'editfoo');
153             INSERT INTO ip (accountid, address) VALUES (1, '192.168.1.0/24');
154            
155             # Simple task based authentication
156             __PACKAGE__->authz->config(
157             DRIVER => [ 'DBI',
158             # the handle comes from $self->dbh, via the "DBH" plugin.
159             TABLES => ['account', 'task'],
160             JOIN_ON => 'account.id = task.accountid',
161             USERNAME => 'account.name',
162             CONSTRAINTS => {
163             'task.name' => '__PARAM_1__',
164             'task.active' => 't'
165             }
166             ],
167             );
168             if ($self->authz->authorize('editfoo') {
169             # User is allowed access if they can 'editfoo'
170             }
171              
172             # IP address configuration
173             __PACKAGE__->authz('byIP')->config(
174             DRIVER => [ 'DBI',
175             SQL => 'SELECT count(*)
176             FROM account JOIN ip ON (account.id = ip.accountid)
177             WHERE account.name = ?
178             AND ip.address >> inet ?
179             ',
180             ],
181             );
182             if ($self->authz('byIP')->authorize($ENV{REMOTE_ADDR}) {
183             # User is allowed to connect from this address
184             }
185              
186             # both together in one test
187             # IP address configuration
188             __PACKAGE__->authz->config(
189             DRIVER => [ 'DBI',
190             SQL => 'SELECT count(*)
191             FROM account
192             JOIN ip ON (account.id = ip.accountid)
193             JOIN task ON (account.id = task.accountid)
194             WHERE account.name = ?
195             AND task.name = ?
196             AND ip.address >> inet ?
197             ',
198             ],
199             );
200             if ($self->authz->authorize('editfoo', $ENV{REMOTE_ADDR}) {
201             # User is allowed to connect from this address if they can
202             # also 'editfoo'
203             }
204              
205              
206             =head1 METHODS
207              
208             =head2 authorize_user
209              
210             This method accepts a username followed by a list of parameters and will
211             return true if the configured query returns at least one row based on the
212             given parameters.
213              
214             =cut
215              
216             sub authorize_user {
217 0     0 1   my $self = shift;
218 0           my $username = shift;
219 0           my @params = @_;
220              
221             # verify that all the options are OK
222 0           my @_options = $self->options;
223 0 0         die "The DBI driver requires a hash of options" if @_options % 2;
224 0           my %options = @_options;
225              
226             # Get a database handle either one that is given to us, or connect using
227             # the information given in the configuration
228 0           my $dbh;
229 0 0         if ( $options{DBH} ) {
    0          
230 0           $dbh = $options{DBH};
231             } elsif ( $self->authen->_cgiapp->can('dbh') ) {
232 0           $dbh = $self->authen->_cgiapp->dbh;
233             } else {
234 0           die "No DBH or passed to the DBI Driver, and no dbh() method detected";
235             }
236              
237             # See if the user provided an SQL option
238 0 0         if ( $options{SQL} ) {
239             # prepare and execute the SQL
240 0   0       my $sth = $dbh->prepare_cached( $options{SQL} )
241             || die "Failed to prepare SQL statement: " . $dbh->errstr;
242 0 0         $sth->execute( $username, @params ) or die $dbh->errstr;
243              
244             # Since we are not pulling specific columns we just check
245             # to see if we matched at least one row
246 0           my ($count) = $sth->fetchrow_array;
247 0           $sth->finish;
248 0 0         return $count ? 1 : 0;
249             }
250              
251             # Grab the database table names (TABLE and TABLES are synonymous)
252 0   0       my $tables = $options{TABLES} || $options{TABLE};
253 0 0         $tables = [$tables] unless ref $tables eq 'ARRAY';
254              
255             # Process the constraints.
256             # We need to check for values indicate they should be replaced by
257             # a parameter (__PARAM_\d+__)
258 0           my %constraints;
259 0           my $used_username = 0;
260 0 0         if ( $options{CONSTRAINTS} ) {
261 0 0         die "CONSTRAINTS must be a hashref"
262             unless ref $options{CONSTRAINTS} eq 'HASH';
263 0           while ( my ( $column, $value ) = each %{ $options{CONSTRAINTS} } ) {
  0            
264 0 0         if ( $value =~ /^__PARAM_(\d+)__$/ ) {
    0          
    0          
265 0           $value = $params[ $1 - 1 ];
266             }
267             elsif ( $value =~ /^__USERNAME__$/ ) {
268 0           $value = $username;
269 0           $used_username = 1;
270             }
271             elsif ( $value =~ /^__GROUP__$/ ) {
272 0           $value = $params[ 0 ];
273             }
274 0           $constraints{$column} = $value;
275             }
276             }
277              
278             # Add in the username constraint if it was provided
279 0 0 0       if ($options{USERNAME}) {
    0          
280 0           $constraints{$options{USERNAME}} = $username;
281             } elsif ( ! $used_username && ! $options{NO_USERNAME} ) {
282 0           warn "Your configuration did not provide for a match against a username column, make sure to provide the USERNAME option, or use the special __USERNAME__ variable in your CONSTRAINTS";
283             }
284              
285             # If we have multiple tables, then we need a join constraint
286 0           my $join_on = $options{JOIN_ON};
287              
288             # Build the SQL statement
289 0           my $sql = 'SELECT count(*) FROM ' . join( ', ', @$tables ) . ' WHERE ';
290 0           my @where;
291 0 0         push @where, $join_on if $join_on;
292 0           push @where, map { $_ . ' = ?' } keys %constraints;
  0            
293 0           $sql .= join( ' AND ', @where );
294 0           my @db_values = values %constraints;
295              
296             # prepare and execute the SQL
297 0   0       my $sth = $dbh->prepare_cached($sql)
298             || die "Failed to prepare SQL statement: " . $dbh->errstr;
299 0 0         $sth->execute(@db_values) or die $dbh->errstr;
300              
301             # Since we are not pulling specific columns we just check
302             # to see if we matched at least one row
303 0           my ($count) = $sth->fetchrow_array;
304 0           $sth->finish;
305 0 0         return $count ? 1 : 0;
306             }
307              
308             =head1 SEE ALSO
309              
310             L,
311             L, perl(1)
312              
313              
314             =head1 LICENCE AND COPYRIGHT
315              
316             Copyright (c) 2005, SiteSuite. All rights reserved.
317              
318             This module is free software; you can redistribute it and/or modify it under
319             the same terms as Perl itself.
320              
321              
322             =head1 DISCLAIMER OF WARRANTY
323              
324             BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE
325             SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE
326             STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE
327             SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED,
328             INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND
329             FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND
330             PERFORMANCE OF THE SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE,
331             YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION.
332              
333             IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY
334             COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE
335             SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE LIABLE TO YOU FOR DAMAGES,
336             INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING
337             OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (INCLUDING BUT NOT LIMITED TO
338             LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU
339             OR THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER
340             SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
341             POSSIBILITY OF SUCH DAMAGES.
342              
343             =cut
344              
345             1;