File Coverage

blib/lib/CGI/Application/Plugin/Authentication/Driver.pm
Criterion Covered Total %
statement 62 68 91.1
branch 16 20 80.0
condition n/a
subroutine 11 12 91.6
pod 9 9 100.0
total 98 109 89.9


line stmt bran cond sub pod time code
1             package CGI::Application::Plugin::Authentication::Driver;
2             $CGI::Application::Plugin::Authentication::Driver::VERSION = '0.23';
3 21     21   1572 use strict;
  21         39  
  21         508  
4 21     21   83 use warnings;
  21         65  
  21         465  
5              
6 21     21   137 use UNIVERSAL::require;
  21         42  
  21         161  
7              
8             =head1 NAME
9              
10             CGI::Application::Plugin::Authentication::Driver - Base module for building driver classes
11             for CGI::Application::Plugin::Authentication
12              
13             =head1 SYNOPSIS
14              
15             package CGI::Application::Plugin::Authentication::Driver::MyDriver;
16             use base qw(CGI::Application::Plugin::Authentication::Driver);
17              
18             sub verify_credentials {
19             my $self = shift;
20             my @credentials = @_;
21              
22             if ( >>> Validate Credentials <<< ) {
23             return $credentials[0];
24             }
25             return;
26             }
27              
28              
29             =head1 DESCRIPTION
30              
31             This module is a base class for all driver classes for the L
32             plugin. Each driver class is required to provide only one method to validate the given credentials.
33             Normally only two credentials will be passed in (username and password), but you can configure the plugin
34             to handle any number of credentials (for example you may require the user to enter a group name, or domain name
35             as well as a username and password).
36              
37              
38             =head1 FIELD FILTERS
39              
40             It is quite common for passwords to be stored using some form of one way encryption. Unix crypt being the
41             old standard in the Unix community, however MD5 or SHA1 hashes are more popular today. In order to
42             simplify the validation routines some methods have been provided to help test these passwords. When
43             configuring a Driver (and if the driver supports it), you can specify which fields are encoded, and which
44             method is used for the encoding by specifying a filter on the field in question.
45              
46             CREDENTIALS => ['authen_username', 'authen_password'],
47             DRIVERS => [ 'DBI',
48             DSN => '...',
49             TABLE => 'users',
50             CONSTRAINTS => {
51             username => '__CREDENTIAL_1__',
52             'MD5:password' => '__CREDENTIAL_2__',
53             }
54             ],
55              
56             Here we are saying that the password field is encoded using an MD5 hash, and should be checked accordingly.
57              
58             =head2 Filter options
59              
60             Some of the filters may have multiple forms. For example there are three forms of MD5 hashes: binary, base64 and hex.
61             You can specify these extra options by using an underscore to separate it from the filter name.
62              
63             'MD5_base64:password'
64              
65              
66             =head2 Chained Filters
67              
68             it is possible to chain multiple filters. This can be useful if your MD5 strings are stored in hex format. Hex numbers are
69             case insensitive, so the may be stored in either upper or lower case. To make this consistent, you can MD5 encode the
70             password first, and then upper case the results. The filters are applied from the inside out:
71              
72             'uc:MD5_hex:password'
73              
74             =head2 Custom Filters
75              
76             If your field is encoded using a custom technique, then you can provide a custom filter function. This can be
77             be done by providing a FILTERS option that contains a hash of filter subroutines that are keyed by their name.
78             You can then use the filter name on any of the fields as if it was a builtin filter.
79              
80             CREDENTIALS => ['authen_username', 'authen_password'],
81             DRIVERS => [ 'DBI',
82             DSN => '...',
83             TABLE => 'users',
84             CONSTRAINTS => {
85             username => '__CREDENTIAL_1__',
86             'rot13:password' => '__CREDENTIAL_2__',
87             }
88             FILTERS => { rot13 => \&rot13_filter },
89             ],
90              
91             sub rot13_filter {
92             my $param = shift;
93             my $value = shift;
94             $value =~ tr/A-Za-z/N-ZA-Mn-za-m/;
95             return $value;
96             }
97              
98             Please see the documentation for the driver that you are using to make sure that it supports encoded
99             fields.
100              
101              
102             =head2 Builtin Filters
103              
104             Here is a list of the filters that are provided with this module:
105              
106             =over 4
107              
108             =item crypt - provided by perl C function
109              
110             =item MD5 - requires Digest::MD5
111              
112             =item SHA1 - requires Digest::SHA1
113              
114             =item uc - provided by the perl C function
115              
116             =item lc - provided by the perl C function
117              
118             =item trim - removed whitespace from the start and end of the field
119              
120             =back
121              
122              
123             =head1 METHODS
124              
125             =head2 new
126              
127             This is a constructor that can create a new Driver object. It requires an Authentication object as its
128             first parameter, and any number of other parameters that will be used as options depending on which
129             Driver object is being created. You shouldn't need to call this as the Authentication plugin takes care
130             of creating Driver objects.
131              
132             =cut
133              
134             sub new {
135 107     107 1 204 my $class = shift;
136 107         212 my $self = {};
137 107         198 my $authen = shift;
138 107         226 my @options = @_;
139              
140 107         197 bless $self, $class;
141 107         319 $self->{authen} = $authen;
142 107         322 Scalar::Util::weaken($self->{authen}); # weaken circular reference
143 107         196 $self->{options} = \@options;
144 107         334 $self->initialize;
145 107         359 return $self;
146             }
147              
148             =head2 initialize
149              
150             This method will be called right after a new Driver object is created. So any startup customizations
151             can be dealt with here.
152              
153             =cut
154              
155             sub initialize {
156 107     107 1 166 my $self = shift;
157             # override this in the subclass if you need it
158 107         166 return;
159             }
160              
161             =head2 options
162              
163             This will return a list of options that were provided when this driver was configured by the user.
164              
165             =cut
166              
167 102     102 1 154 sub options { return (@{$_[0]->{options}}) }
  102         281  
168              
169             =head2 authen
170              
171             This will return the underlying L object. In most cases it will
172             not be necessary to access this.
173              
174             =cut
175              
176 1     1 1 5 sub authen { return $_[0]->{authen} }
177              
178             =head2 find_option
179              
180             This method will search the Driver options for a specific key and return
181             the value it finds.
182              
183             =cut
184              
185             sub find_option {
186 12     12 1 787 my $self = shift;
187 12         20 my $key = shift;
188 12         31 my @options = $self->options;
189 12         28 my $marker = 0;
190 12         21 foreach my $option (@options) {
191 20 100       42 if ($marker) {
    100          
192 7         20 return $option;
193             } elsif ($option eq $key) {
194             # We need the next element
195 7         12 $marker = 1;
196             }
197             }
198 5         18 return;
199             }
200              
201             =head2 verify_credentials
202              
203             This method needs to be provided by the driver class. It needs to be an object method that accepts a list of
204             credentials, and will verify that the credentials are valid, and return a username that will be used to identify
205             this login (usually you will just return the value of the first credential, however you are not bound to that)..
206              
207             =cut
208              
209             sub verify_credentials {
210 1     1 1 9 die "verify_credentials must be implemented in the subclass";
211             }
212              
213             =head2 filter
214              
215             This method can be used to filter a field (usually password fields) using a number of standard or
216             custom encoding techniques. See the section on Builtin Filters above to see what filters are available
217             When using a custom filter, you will need to provide a FILTERS option in the configuration of the DRIVER (See the
218             section on FIELD FILTERS above for an example). By default, if no filter is specified, it is
219             returned as is. This means that you can run all fields through this function even if they
220             don't have any filters to simplify the driver code.
221              
222             my $filtered = $self->filter('MD5_hex:password', 'foobar');
223              
224             - or -
225              
226             # custom filter
227             my $filtered = $self->filter('foobar:password', 'foo');
228              
229             - or -
230              
231             # effectively a noop
232             my $filtered = $self->filter('username', 'foo');
233              
234              
235              
236             =cut
237              
238             sub filter {
239 20     20 1 545 my $self = shift;
240 20         36 my $field = shift;
241 20         26 my $plain = shift;
242 20         39 my @other = shift;
243              
244 20 50       40 return unless defined $plain;
245              
246 20         52 my @filters = split /\:/, $field;
247 20         34 my $fieldname = pop @filters;
248              
249 20         32 my $filtered = $plain;
250 20         39 foreach my $filter (reverse @filters) {
251              
252 27         80 my ($filter_name, $param) = split /_/, $filter;
253 27         70 my $class = 'CGI::Application::Plugin::Authentication::Driver::Filter::' . lc $filter_name;
254 27 100       144 if ( $class->require ) {
255             # found a filter
256 21         838 $filtered = $class->filter( $param, $filtered, @other );
257             } else {
258             # see if the configuration has a custom filter defined
259 6         225 my $custom_filters = $self->find_option('FILTERS');
260 6 100       17 if ( $custom_filters ) {
261 4 100       17 die "the FILTERS configuration option must be a hashref"
262             unless ref( $custom_filters ) eq 'HASH';
263 3 100       8 if ( $custom_filters->{$filter_name} ) {
264             die "the '$filter' filter listed in FILTERS must be a subroutine reference"
265 2 100       14 unless ref( $custom_filters->{$filter_name} ) eq 'CODE';
266 1         5 $filtered = $custom_filters->{$filter_name}->( $param, $filtered, @other );
267             } else {
268 1         8 die "No filter found for '$filter_name'";
269             }
270             } else {
271 2         17 die "No filters found for '$filter'";
272             }
273             }
274             }
275 11         60 return $filtered;
276             }
277              
278             =head2 check_filtered
279              
280             This method can be used to test filtered fields (usually password fields) against a number of standard or
281             custom encoding techniques. The following encoding techniques are provided: plain, MD5, SHA1, crypt.
282             When using a custom encoder, you will need to provide it in the configuration of the DRIVERS (See the
283             section on ENCODED PASSWORDS above for an example). By default, if no encoding is specified, it is
284             assumed to be 'plain'. This means that you can run all fields through this function even if they
285             don't have any encoding to simplify the driver code.
286              
287             my $verified = $self->check_filtered('MD5:password', 'foobar', 'OFj2IjCsPJFfMAxmQxLGPw');
288              
289             - or -
290              
291             # custom encoder
292             my $verified = $self->check_filtered('foobar:password', 'foo', 'bar');
293              
294             - or -
295              
296             # a field that isn't filtered (effectively just checks for equality on second and third args)
297             my $verified = $self->check_filtered('username', 'foobar', 'foobar');
298             my $verified = $self->check_filtered('plain:username', 'foobar', 'foobar');
299              
300             =cut
301              
302             sub check_filtered {
303 0     0 1 0 my $self = shift;
304 0         0 my $field = shift;
305 0         0 my $plain = shift;
306 0         0 my $filtered = shift;
307              
308 0 0       0 return ($self->filter($field, $plain, $filtered) eq $filtered) ? 1 : 0;
309             }
310              
311             =head2 strip_field_names
312              
313             This method will take a field name (or list of names) and strip off the leading encoding type.
314             For example if you passed in 'MD5:password' the method would return 'password'.
315              
316             my $fieldname = $self->strip_field_names('MD5:password');
317              
318             =cut
319              
320             sub strip_field_names {
321 2     2 1 4 my $self = shift;
322 2         3 my @fields = @_;
323              
324 2         4 foreach (@fields) {
325 2         4 s/^.*://;
326             }
327 2 50       3 if (wantarray()) {
328 0         0 return @fields;
329             } else {
330 2         6 return $fields[0];
331             }
332             }
333              
334              
335             =head1 SEE ALSO
336              
337             L, perl(1)
338              
339              
340             =head1 AUTHOR
341              
342             Cees Hek
343              
344              
345             =head1 LICENCE AND COPYRIGHT
346              
347             Copyright (c) 2005, SiteSuite. All rights reserved.
348              
349             This module is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
350              
351              
352             =head1 DISCLAIMER OF WARRANTY
353              
354             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.
355              
356             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.
357              
358             =cut
359              
360             1;