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; |