File Coverage

blib/lib/CGI/Application/Plugin/Authentication/Driver/DBI.pm
Criterion Covered Total %
statement 49 71 69.0
branch 15 38 39.4
condition 2 5 40.0
subroutine 4 4 100.0
pod 1 1 100.0
total 71 119 59.6


line stmt bran cond sub pod time code
1             package CGI::Application::Plugin::Authentication::Driver::DBI;
2             $CGI::Application::Plugin::Authentication::Driver::DBI::VERSION = '0.21';
3 2     2   10 use strict;
  2         3  
  2         58  
4 2     2   50 use warnings;
  2         4  
  2         71  
5              
6 2     2   8 use base qw(CGI::Application::Plugin::Authentication::Driver);
  2         4  
  2         1292  
7              
8             =head1 NAME
9              
10             CGI::Application::Plugin::Authentication::Driver::DBI - DBI Authentication driver
11              
12             =head1 SYNOPSIS
13              
14             use base qw(CGI::Application);
15             use CGI::Application::Plugin::Authentication;
16              
17             __PACKAGE__->authen->config(
18             DRIVER => [ 'DBI',
19             DBH => $self->dbh,
20             TABLE => 'user',
21             CONSTRAINTS => {
22             'user.name' => '__CREDENTIAL_1__',
23             'MD5:user.password' => '__CREDENTIAL_2__'
24             },
25             ],
26             );
27              
28              
29             =head1 DESCRIPTION
30              
31             This Authentication driver uses the DBI module to allow you to authenticate against
32             any database for which there is a DBD module. You can either provide an active
33             database handle, or provide the parameters necessary to connect to the database.
34              
35             When describing the database structure, you need to specify some or all of the
36             following parameters: TABLE(S), JOIN_ON, COLUMNS, CONSTRAINTS, ORDER_BY and
37             LIMIT.
38              
39             =head2 DBH
40              
41             The DBI database handle to use. Defaults to C<$self->dbh()>, which is provided and configured
42             through L
43              
44             =head2 TABLE(S) (required)
45              
46             Provide either a single table name, or an array of table names. You can give the
47             table names aliases which can be referenced in later columns.
48              
49             TABLE => 'users',
50              
51             - or -
52              
53             TABLES => ['users U', 'domains D'],
54              
55              
56             =head2 JOIN_ON (conditionally required)
57              
58             If you have specified multiple tables, then you need to provide an SQL expression that
59             can be used to join those tables.
60              
61             JOIN_ON => 'user.domainid = domain.id',
62              
63             - or -
64              
65             JOIN_ON => 'U.domainid = D.id',
66              
67              
68             =head2 COLUMNS (optional)
69              
70             This is a hash of columns/values that should be pulled out of the database and validated
71             locally in perl. Most credentials can be checked right in the database (example
72             username = ?), but some parameters may need to be tested locally in perl, so they
73             must be listed in the COLUMNS option. One example of a value that needs to be tested
74             in perl is a crypted password. In order to test a crypted password, you need to
75             take the entered password, and crypt it with the salt of the already crypted password.
76             But until we actually see the password that is in the database, we will not know the
77             value of the salt that was used to encrypt the password. So we pull the value out
78             using COLUMNS, and the test will be performed automatically in perl.
79              
80             Any value that matches __CREDENTIAL_n__ (where n is a number) will be replaced with
81             the corresponding credential that was entered by the user. For an explanation of
82             what the credentials are and where they come from, see the section headed with
83             CREDENTIALS in L.
84              
85             COLUMNS => { 'crypt:password' => '__CREDENTIAL_2__' },
86              
87              
88             =head2 CONSTRAINTS (optional)
89              
90             You will most likely always have some constraints to use. These constraints
91             will be added to the WHERE clause of the SQL query, and will ideally reduce
92             the number of returned rows to one.
93              
94             Any value that matches __CREDENTIAL_n__ (where n is a number) will be replaced with
95             the corresponding credential that was entered by the user. For an explanation of
96             what the credentials are and where they come from, see the section headed with
97             CREDENTIALS in L.
98              
99             CONSTRAINTS => {
100             'users.email' => '__CREDENTIAL_1__',
101             'MD5:users.passphrase' => '__CREDENTIAL_2__',
102             'users.active' => 1,
103             }
104              
105              
106             =head2 ORDER_BY (optional)
107              
108             This option allows you to order the result set, in case the query returns
109             multiple rows.
110              
111             ORDER_BY => 'created DESC'
112              
113             Note: This option is only useful if you also specify the COLUMNS option.
114              
115             =head2 LIMIT (optional)
116              
117             In some situations your query may return multiple rows when you only want it to
118             return one. For example if you insert and date a new row instead of updating
119             the existing row when the details for an account change. In this case you want
120             the newest record from the result set, so it will be important to order the
121             result set and limit it to return only one row.
122              
123             LIMIT => 1
124              
125             Note: This option is only useful if you also specify the COLUMNS option.
126              
127             =head1 ENCODED PASSWORDS
128              
129             It is quite common to store passwords in a database in some form that makes them hard
130             (or virtually impossible) to guess. Most of the time one way encryption techniques
131             like Unix crypt or MD5 hashes are used to store the password securely (I would recommend
132             using MD5 or SHA1 over Unix crypt). If you look at the examples listed above, you can
133             see that you can mark your columns with an encoding type. Here is another example:
134              
135             CONSTRAINTS => {
136             username => '__CREDENTIAL_1__',
137             'MD5:password' => '__CREDENTIAL_2__',
138             }
139              
140             Here the password field is expected to be stored in the database in MD5 format. In order for the
141             MD5 check to work for all databases, the password will be encoded using perl, and then checked
142             against the value in the database. So in effect, the following will be done:
143              
144             $username = 'test';
145             $password = '123';
146             $encoded_password = 'ICy5YqxZB1uWSwcVLSNLcA';
147             $sth = $dbh->prepare('SELECT count(*) FROM users WHERE username = ? AND password = ?';
148             $sth->execute($username, $encoded_password);
149             # I we found a row, then the user credentials are valid and the user is logged in
150              
151             This is all automatically performed behind the scenes when you specify that a certain field
152             in the database is encoded.
153              
154             We have to handle this slightly different when working with Unix crypt. In order to crypt
155             a password, you need to provide the crypt function with a 2 character salt value. These are
156             usually just generated randomly, and when the value is crypted, the first two characters of
157             the resulting string will be the 2 salt characters. The problem comes into play when you want
158             to check a password against a crypted password. You need to know the salt in order to
159             properly test the password. But in our case, the crypted password is in the DB. This means we
160             can not generate the crypted test password before we run the query against the database.
161              
162             So instead we pull the value of the crypted password out of the database, and then perform the
163             tests after the query, instead of before. Here is an example:
164              
165             CONSTRAINTS => { 'username' => '__CREDENTIAL_1__' },
166             COLUMNS => { 'crypt:password' => '__CREDENTIAL_2__' },
167              
168             And here is what will happen behind the scenes:
169              
170             $username = 'test';
171             $password = '123';
172             $sth = $dbh->prepare('SELECT password FROM users WHERE username = ?';
173             $sth->execute($username);
174             ($encoded_password) = $sth->fetchrow_array;
175             if ($encoded_password eq crypt($password, $encoded_password)) {
176             # The credentials are valid and the user is logged in
177             }
178              
179             Again, this is all done automatically behind the scenes, but I've included it here to illustrate how
180             the queries are performed, and how the comparisons are handled. For more information
181             see the section labelled ENCODED PASSWORDS in the L
182             docs.
183              
184              
185              
186             =head1 EXAMPLE
187              
188             # using multiple tables
189             # Here we check three credentials (user, password and domain) across
190             # two separate tables.
191             __PACKAGE__->authen->config(
192             DRIVER => [ 'DBI',
193             # the handle comes from $self->dbh, via the "DBH" plugin.
194             TABLES => ['user', 'domain'],
195             JOIN_ON => 'user.domainid = domain.id',
196             CONSTRAINTS => {
197             'user.name' => '__CREDENTIAL_1__',
198             'user.password' => '__CREDENTIAL_2__',
199             'domain.name' => '__CREDENTIAL_3__'
200             }
201             ],
202             );
203              
204             - or -
205              
206             # using filtered fields
207             # Here the password column contains values that are encoded using unix crypt
208             # and since we need to know the salt in order to encrypt the password
209             # properly, we need to pull out the password, and check it locally
210             __PACKAGE__->authen->config(
211             DRIVER => [ 'DBI',
212             DBH => $dbh, # provide your own DBI handle
213             TABLE => 'user',
214             CONSTRAINTS => { 'user.name' => '__CREDENTIAL_1__' }
215             COLUMNS => { 'crypt:password' => '__CREDENTIAL_2__' },
216             ],
217             );
218              
219             - or -
220              
221             # extra constraints
222             # Here we only check users where the 'active' column is true
223             __PACKAGE__->authen->config(
224             DRIVER => [ 'DBI',
225             TABLE => 'user',
226             CONSTRAINTS => {
227             'user.name' => '__CREDENTIAL_1__',
228             'user.password' => '__CREDENTIAL_2__',
229             'user.active' => 't'
230             },
231             ],
232             );
233              
234             - or -
235              
236             # all of them combined
237             # Here the user is required to enter a username and password (which is
238             # crypted), and a daily code that changes every day (which is encoded using
239             # an MD5 hash hex format and stored in upper case).
240             __PACKAGE__->authen->config(
241             DRIVER => [ 'DBI',
242             TABLES => ['user U', 'dailycode D'],
243             JOIN_ON => 'U.userid = D.userid',
244             CONSTRAINTS => {
245             'U.name' => '__CREDENTIAL_1__',
246             'uc:md5_hex:D.code' => '__CREDENTIAL_3__',
247             'D.date' => 'now'
248             },
249             COLUMNS => {
250             'crypt:U.password' => '__CREDENTIAL_2__'
251             },
252             ],
253             );
254              
255              
256              
257             =head1 METHODS
258              
259             =head2 verify_credentials
260              
261             This method will test the provided credentials against the values found in the database,
262             according to the Driver configuration.
263              
264             =cut
265              
266             sub verify_credentials {
267 3     3 1 3 my $self = shift;
268 3         7 my @creds = @_;
269              
270             # verify that all the options are OK
271 3         15 my @_options = $self->options;
272 3 100       17 die "The DBI driver requires a hash of options" if @_options % 2;
273 2         6 my %options = @_options;
274              
275             # Get a database handle - either one that is given to us, or see if there
276             # is a ->dbh method in the CGIApp module (This is provided by the
277             # CGI::Application::Plugin::DBH module, so use it if it is there).
278 2         3 my $dbh;
279 2 100       20 if ( $options{DBH} ) {
    50          
280 1         2 $dbh = $options{DBH};
281             } elsif ( $self->authen->_cgiapp->can('dbh') ) {
282 0         0 $dbh = $self->authen->_cgiapp->dbh;
283             } else {
284 1         8 die "No DBH handle passed to the DBI Driver, and no dbh() method detected";
285             }
286              
287             # Grab the database table names (TABLE and TABLES are synonymous)
288 1   33     5 my $tables = $options{TABLES} || $options{TABLE};
289 1 50       10 die "No TABLE parameter defined" unless defined($tables);
290 1 50       5 $tables = [$tables] unless ref $tables eq 'ARRAY';
291              
292             # See if we need to order the result set
293 1 50       5 my $order_by = $options{ORDER_BY} ? ' ORDER BY '.$options{ORDER_BY} : '';
294              
295             # See if we need to limit the result set
296 1 50       2 my $limit = $options{LIMIT} ? ' LIMIT '.$options{LIMIT} : '';
297              
298             # Grab all the columns that we need to pull out. We also grab a list of
299             # columns that are stripped of any encoding information.
300             # If no columns are provided we just select count(*) for efficiency.
301 1         2 my @columns;
302             my @stripped_columns;
303 1 50       3 if ( $options{COLUMNS} ) {
304 0 0       0 die "COLUMNS must be a hashref" unless ref $options{COLUMNS} eq 'HASH';
305 0         0 @columns = keys %{ $options{COLUMNS} };
  0         0  
306 0         0 @stripped_columns = $self->strip_field_names(@columns);
307             } else {
308 1         3 @columns = ('count(*)');
309 1         2 @stripped_columns = @columns;
310             }
311              
312             # Process the constraints.
313             # We need to check for values indicate they should be replaced by
314             # a credential (__CREDENTIAL_\d+__), and we need to filter any values
315             # that are configured to be filtered
316 1         1 my %constraints;
317 1 50       4 if ( $options{CONSTRAINTS} ) {
318 1 50       4 die "CONSTRAINTS must be a hashref" unless ref $options{CONSTRAINTS} eq 'HASH';
319 1         2 while ( my ( $column, $value ) = each %{ $options{CONSTRAINTS} } ) {
  3         16  
320 2 50       13 if ( $value =~ /^__CREDENTIAL_(\d+)__$/ ) {
321 2         9 $value = $creds[ $1 - 1 ];
322             }
323 2         12 $value = $self->filter( $column, $value );
324 2         9 $column = $self->strip_field_names($column);
325 2         5 $constraints{$column} = $value;
326             }
327             }
328              
329             # If we have multiple tables, then we need a join constraint
330 1         2 my $join_on = $options{JOIN_ON};
331              
332             # Build the SQL statement
333 1         5 my $sql = 'SELECT ' . join( ', ', @stripped_columns ) . ' FROM ' . join( ', ', @$tables ) . ' WHERE ';
334 1         2 my @where;
335 1 50       3 push @where, $join_on if $join_on;
336 1         3 push @where, map { $_ . ' = ?' } keys %constraints;
  2         9  
337 1         4 $sql .= join( ' AND ', @where );
338 1         3 my @params = values %constraints;
339 1         2 $sql .= $order_by;
340 1         2 $sql .= $limit;
341              
342             # prepare and execute the SQL
343 1   50     13 my $sth = $dbh->prepare_cached($sql) || die "Failed to prepare SQL statement: " . $dbh->errstr;
344 1 50       105 $sth->execute(@params) or die $dbh->errstr;
345              
346             # Figure out what to do with the results
347 0 0         if ( $options{COLUMNS} ) {
348             # Since we pulled out some columns, we assume that these columns were not checked
349             # in the constraints section, and we test them here.
350             # It is possible that we could have multiple rows, so keep checking until we
351             # find a row where all comparisons are successful.
352 0           while ( my @array = $sth->fetchrow_array ) {
353 0           my $match = 1;
354 0           foreach my $index ( 0 .. $#columns ) {
355 0           my $value = $options{COLUMNS}->{ $columns[$index] };
356 0 0         if ( $value =~ /^__CREDENTIAL_(\d+)__$/ ) {
357 0           $value = $creds[ $1 - 1 ];
358             }
359 0 0         if ( !$self->check_filtered( $columns[$index], $value, $array[$index] ) ) {
360             # This test failed, so there is no sense checking the rest of the values
361             # in this row so we bail out early
362 0           $match = 0;
363 0           last;
364             }
365             }
366 0 0         if ($match) {
367             # we found a match so clean up and return the first credential
368 0           $sth->finish;
369 0           return $creds[0];
370             }
371             }
372             } else {
373             # Since we are not pulling specific columns we just check
374             # to see if we matched at least one row
375 0           my ($count) = $sth->fetchrow_array;
376 0           $sth->finish;
377 0 0         return $creds[0] if $count;
378             }
379 0           return;
380             }
381              
382             =head1 SEE ALSO
383              
384             L, L, perl(1)
385              
386              
387             =head1 LICENCE AND COPYRIGHT
388              
389             Copyright (c) 2005, SiteSuite. All rights reserved.
390              
391             This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
392              
393              
394             =head1 DISCLAIMER OF WARRANTY
395              
396             BECAUSE THIS SOFTWARE IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY FOR THE SOFTWARE, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE SOFTWARE "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE SOFTWARE IS WITH YOU. SHOULD THE SOFTWARE PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR, OR CORRECTION.
397              
398             IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR REDISTRIBUTE THE SOFTWARE AS PERMITTED BY THE ABOVE LICENCE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL, OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE THE SOFTWARE (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD PARTIES OR A FAILURE OF THE SOFTWARE TO OPERATE WITH ANY OTHER SOFTWARE), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
399              
400             =cut
401              
402             1;