File Coverage

blib/lib/MyLibrary/Auth.pm
Criterion Covered Total %
statement 21 127 16.5
branch 0 22 0.0
condition 1 24 4.1
subroutine 7 21 33.3
pod 7 8 87.5
total 36 202 17.8


line stmt bran cond sub pod time code
1             package MyLibrary::Auth;
2              
3 1     1   7 use MyLibrary::Patron;
  1         2  
  1         34  
4 1     1   6 use MyLibrary::Config;
  1         2  
  1         27  
5 1     1   6 use MyLibrary::DB;
  1         2  
  1         28  
6 1     1   1336 use CGI::Session qw/-ip-match/;
  1         6587  
  1         33  
7 1     1   49 use Carp qw(croak);
  1         3  
  1         76  
8              
9 1     1   6 use strict;
  1         2  
  1         1483  
10              
11             =head1 NAME
12              
13             MyLibrary::Auth
14              
15             =head1 SYNOPSIS
16              
17             use MyLibrary::Auth;
18              
19             # create a new authentication object
20             my $auth = MyLibrary::Auth->new();
21             my $auth = MyLibrary::Auth->new(sessid => $sessid);
22              
23             # access session attributes
24             my $sessid = $auth->sessid();
25             my $status = $auth->status();
26             my $username = $auth->username();
27            
28             # place session cookie
29             $auth->place_cookie();
30              
31             # remove session cookie
32             $auth->remove_cookie();
33              
34             # close a session
35             $auth->close_session();
36              
37             =head1 DESCRIPTION
38              
39             This is the user authentication system for MyLibrary. The parent module, Auth.pm, references several child modules that implement various types of authentication methods. The functionality associated with creating an authentication object and then performing auth functions against it is uniform for each type of authentication. This module encapsulates data somewhat tightly in order to protect the privacy and security of the user. This module assumes authentication through a web browser, however, the module could also be used for simple authentication in almost any context.
40              
41             This system uses CGI sessions to maintain state. Several pieces of data are stored in the session ticket. Except for Basic authentication, the password for the user is never recorded. If this module is used for web authentication, then HTTPS should also be used for encryption. This authentication system is designed to be extensible. Several modules will be written that inherit from this parent class. Child classes include Kerberos, Basic and LDAPS as various means to perform authentication. However, the system can easily be extended to include other authentication means.
42              
43             =head1 METHODS
44              
45             =head2 new()
46              
47             This is the constructor for the class. It creates an object with a default set of attributes if no session id is supplied, and initializes the attributes according to session data previously saved if a session id is supplied. This object uses encapsulated data, so the only means to manipulate session variables is via the supplied API. This is done for security reasons and to help maintain data integrity.
48              
49             # create a new auth object
50             my $auth = MyLibrary::Auth->new();
51              
52             # create an auth object based upon session id
53             my $auth = MyLibrary::Auth->new(sessid => $sessid);
54              
55             =head2 sessid()
56              
57             Get the session id for the current auth object. This method cannot set the session id, only retrieve it.
58              
59             # get the session id
60             my $sessid = $auth->sessid();
61              
62             =head2 status()
63              
64             Retrieve the status for this session. There are several status indicators based upon whether or not the user was able to successfully authenticate or is in the process of authentication. The state of authentication status can only be changed internal to the object itself.
65              
66             # status info
67             my $status = $auth->status();
68              
69             =head2 username()
70              
71             The username is the name entered for authentication purposes and is retained throughout the life of the session. This is used to identify who the last person was to authenticate from the host where authentication was initiated.
72              
73             # username
74             my $username = $auth->username();
75              
76             =head2 place_cookie()
77              
78             This method will return a header used to place a cookie with the browser initiating the authentication request.
79              
80             # place a cookie
81             my $place_cookie_header = $auth->place_cookie();
82              
83             =head2 remove_cookie()
84              
85             This method return a header that will delete a cookie from the browser for the current session. This usually occurs when the user indicate that they would like their session terminated.
86              
87             # delete a cookie
88             my $remove_cookie_header = $auth->remove_cookie();
89              
90             =head2 close_session()
91              
92             This method will delete the session object from the database, and it will no longer be accessible using the session id.
93              
94             # close the session
95             $auth->close_session()
96              
97             =head1 SEE ALSO
98              
99             For more information, see the MyLibrary home page: http://dewey.library.nd.edu/mylibrary/.
100              
101             =head1 AUTHORS
102              
103             Robert Fox
104              
105             =cut
106              
107              
108             # Stores references to hashes containing object data
109             my %_auth_obj;
110              
111             {
112             # Allowable object attributes with defaults
113             my %_attr_data =
114             ( sessid => undef,
115             status => 'not authenticated',
116             user_id => undef,
117             username => undef,
118             session_expire => undef,
119             file => __FILE__
120             );
121             # Class methods used to operate on encapsulated data
122             sub _attr_defaults {
123 0     0   0 my $sessid = shift;
124 0         0 $_attr_data{'sessid'} = $sessid;
125 0         0 return \%_attr_data;
126             }
127              
128             sub _standard_keys {
129 0     0   0 keys %_attr_data;
130             }
131             }
132              
133              
134             sub new {
135 1     1 1 928 my ($self, %args) = @_;
136 1   33     10 my $class = ref($self) || $self;
137 1         9 my $dbh = MyLibrary::DB->dbh();
138 0 0         if (my $sessid = $args{sessid}) {
139 0           my $session;
140 0 0         if ($MyLibrary::Config::DATA_SOURCE =~ /mysql/) {
141 0           $session = CGI::Session->new("driver:mysql", $sessid, { Handle => $dbh });
142             } else {
143 0           $session = CGI::Session->new("driver:File", $sessid, {Directory=>$MyLibrary::Config::SESSION_DIR});
144             }
145 0           my $_attr_flds_ref = {};
146 0           my $_session_params = $session->param_hashref();
147 0           foreach my $attr (keys %$_session_params) {
148            
149             # changed, based on http://www.issociate.de/board/post/260444/Deprecated_perl_hash_reference_statement_problem.html --ELM
150             #$_attr_flds_ref->{$attr} = %$_session_params->{$attr};
151 0           $_attr_flds_ref->{$attr} = ${$_session_params}{$attr};
  0            
152              
153             }
154             $_attr_flds_ref->{status_accessor} = sub {
155 0     0     my $self = shift;
156 0           my $status = shift;
157 0 0 0       if (defined($status) && $status =~ /^not authenticated$|^authenticated$|^failed authentication - invalid username$|^failed authentication - invalid password$|^failed authentication - user not in patron table$|^expired$/) {
158 0           return $_auth_obj{${$self}}->{status} = $status;
  0            
159             } else {
160 0           return $_auth_obj{${$self}}->{status};
  0            
161             }
162 0           };
163 0           $_attr_flds_ref->{_sess_ref} = $session;
164 0   0       $_attr_flds_ref->{_key} = rand
165             until $_attr_flds_ref->{_key} && !exists $_auth_obj{$_attr_flds_ref->{_key}};
166 0           $_auth_obj{$_attr_flds_ref->{_key}} = $_attr_flds_ref;
167 0           return bless(\$_attr_flds_ref->{_key}, $class);
168             } else {
169 0           my $session;
170 0 0         if ($MyLibrary::Config::DATA_SOURCE =~ /mysql/) {
171 0           $session = CGI::Session->new("driver:mysql", undef, { Handle => $dbh });
172             } else {
173 0           $session = CGI::Session->new("driver:File", undef, {Directory=>$MyLibrary::Config::SESSION_DIR});
174             }
175 0           my $sessid = $session->id();
176 0           my $_base_attr_fields = _attr_defaults($sessid);
177 0           my $_attr_fields = $self->_attr_defaults();
178 0           my $_attr_flds_ref = {%{$_base_attr_fields}, %{$_attr_fields}};
  0            
  0            
179 0           foreach my $attr (keys %{$_attr_flds_ref}) {
  0            
180 0 0         $_attr_flds_ref->{$attr} = $args{$attr} if defined $args{$attr};
181 0           $session->param($attr, $_attr_flds_ref->{$attr});
182             }
183             $_attr_flds_ref->{status_accessor} = sub {
184 0     0     my $self = shift;
185 0           my $status = shift;
186 0 0 0       if (defined($status) && $status =~ /^not authenticated$|^authenticated$|^failed authentication$|^expired$/) {
187 0           return $_auth_obj{${$self}}->{status} = $status;
  0            
188             } else {
189 0           return $_auth_obj{${$self}}->{status};
  0            
190             }
191 0           };
192 0           $_attr_flds_ref->{_sess_ref} = $session;
193 0   0       $_attr_flds_ref->{_key} = rand
194             until $_attr_flds_ref->{_key} && !exists $_auth_obj{$_attr_flds_ref->{_key}};
195 0           $_auth_obj{$_attr_flds_ref->{_key}} = $_attr_flds_ref;
196 0           return bless(\$_attr_flds_ref->{_key}, $class);
197             }
198             }
199              
200             sub sessid {
201 0     0 1   my $self = shift;
202 0           return $_auth_obj{${$self}}->{sessid};
  0            
203             }
204              
205             sub status {
206 0     0 1   my $self = shift;
207 0 0         if ($_auth_obj{${$self}}->{status_accessor}->($self) eq 'authenticated') {
  0            
208 0 0         unless ($self->_logged_in()) {
209 0           $_auth_obj{${$self}}->{status_accessor}->($self, 'expired');
  0            
210 0           return $_auth_obj{${$self}}->{status_accessor}->($self);
  0            
211             }
212 0           return $_auth_obj{${$self}}->{status_accessor}->($self);
  0            
213             } else {
214 0           return $_auth_obj{${$self}}->{status_accessor}->($self);
  0            
215             }
216             }
217              
218             sub user_id {
219 0     0 0   my $self = shift;
220 0           return $_auth_obj{${$self}}->{user_id};
  0            
221             }
222              
223             sub username {
224 0     0 1   my $self = shift;
225 0           return $_auth_obj{${$self}}->{username};
  0            
226             }
227              
228             sub _logged_in {
229 0     0     my $self = shift;
230 0           return $_auth_obj{${$self}}->{_sess_ref}->param('_logged_in');
  0            
231             }
232              
233             sub place_cookie {
234 0     0 1   my $self = shift;
235 0           return $self->_header();
236             }
237              
238             sub remove_cookie {
239 0     0 1   my $self = shift;
240 0           return $self->_header(action => 'remove');
241             }
242              
243             sub close_session {
244              
245 0     0 1   my $self = shift;
246 0           my $session = $_auth_obj{${$self}}->{_sess_ref};
  0            
247 0           $session->delete();
248 0           return 1;
249              
250             }
251              
252             sub _header {
253 0     0     my $self = shift;
254 0           my %args = @_;
255 0           my $session = $_auth_obj{${$self}}->{_sess_ref};
  0            
256 0           my $expire_time;
257 0           my $cgi = $session->{_SESSION_OBJ};
258 0 0         unless ( defined $cgi ) {
259 0           require CGI;
260 0           $session->{_SESSION_OBJ} = CGI->new();
261 0           $cgi = $session->{_SESSION_OBJ};
262             }
263 0 0 0       if (defined $args{action} && $args{action} eq 'remove') {
264 0           $expire_time = '-1d';
265             } else {
266 0           $expire_time = '+10M';
267             }
268 0           my $cookie = $cgi->cookie(-name=>'mylib_sessid',-value=>$session->id(), -path=>$MyLibrary::Config::RELATIVE_PATH,
269             -domain=>$MyLibrary::Config::COOKIE_DOMAIN, -expires=>$expire_time);
270 0           return $cgi->header(
271             -type => 'text/html',
272             -cookie => $cookie,
273             @_
274             );
275             }
276              
277             sub _attr_hash {
278 0     0     my $self = shift;
279 0           my @caller = caller();
280 0 0 0       if ($caller[0] eq 'main' || $caller[0] !~ /^MyLibrary::Auth::\w+/ || $caller[1] ne $_auth_obj{${$self}}->{file}) {
  0   0        
281 0           croak "Illegal call to private MyLibrary::Auth method";
282             }
283 0           return \%_auth_obj;
284             }
285              
286             1;