| 1 | ################################################################################ |
1 | ################################################################################ |
| 2 | # WeBWorK mod_perl (c) 2000-2002 WeBWorK Project |
2 | # WeBWorK Online Homework Delivery System |
| 3 | # $Id$ |
3 | # Copyright © 2000-2003 The WeBWorK Project, http://openwebwork.sf.net/ |
|
|
4 | # $CVSHeader$ |
|
|
5 | # |
|
|
6 | # This program is free software; you can redistribute it and/or modify it under |
|
|
7 | # the terms of either: (a) the GNU General Public License as published by the |
|
|
8 | # Free Software Foundation; either version 2, or (at your option) any later |
|
|
9 | # version, or (b) the "Artistic License" which comes with this package. |
|
|
10 | # |
|
|
11 | # This program is distributed in the hope that it will be useful, but WITHOUT |
|
|
12 | # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS |
|
|
13 | # FOR A PARTICULAR PURPOSE. See either the GNU General Public License or the |
|
|
14 | # Artistic License for more details. |
| 4 | ################################################################################ |
15 | ################################################################################ |
| 5 | |
16 | |
| 6 | package WeBWorK::Authen; |
17 | package WeBWorK::Authen; |
| 7 | |
18 | |
| 8 | =head1 NAME |
19 | =head1 NAME |
| … | |
… | |
| 11 | |
22 | |
| 12 | =cut |
23 | =cut |
| 13 | |
24 | |
| 14 | use strict; |
25 | use strict; |
| 15 | use warnings; |
26 | use warnings; |
| 16 | use WeBWorK::DB::Auth; |
|
|
| 17 | |
27 | |
| 18 | sub new($$$) { |
28 | sub new($$$) { |
| 19 | my $invocant = shift; |
29 | my $invocant = shift; |
| 20 | my $class = ref($invocant) || $invocant; |
30 | my $class = ref($invocant) || $invocant; |
| 21 | my $self = {}; |
31 | my $self = {}; |
| 22 | ($self->{r}, $self->{ce}) = @_; |
32 | ($self->{r}, $self->{ce}, $self->{db}) = @_; |
| 23 | bless $self, $class; |
33 | bless $self, $class; |
| 24 | return $self; |
34 | return $self; |
| 25 | } |
35 | } |
| 26 | |
36 | |
|
|
37 | # um, this isn't used. move it to Utils? |
|
|
38 | #sub generatePassword($$$) { |
|
|
39 | # my ($self, $userID, $clearPassword) = @_; |
|
|
40 | # my $salt = join("", ('.','/','0'..'9','A'..'Z','a'..'z')[rand 64, rand 64]); |
|
|
41 | # my $cryptPassword = crypt($clearPassword, $salt); |
|
|
42 | # return WeBWorK::DB::Record::Password->new(user_id=>$userID, password=>$password); |
|
|
43 | #} |
|
|
44 | |
|
|
45 | sub checkPassword($$$) { |
|
|
46 | my ($self, $userID, $possibleClearPassword) = @_; |
|
|
47 | my $Password = $self->{db}->getPassword($userID); # checked |
|
|
48 | return 0 unless defined $Password; |
|
|
49 | my $possibleCryptPassword = crypt($possibleClearPassword, $Password->password()); |
|
|
50 | return $possibleCryptPassword eq $Password->password(); |
|
|
51 | } |
|
|
52 | |
| 27 | sub generate_key { |
53 | sub generateKey($$) { |
| 28 | # Package constants. These should never be changed in other places ever |
54 | my ($self, $userID) = @_; |
| 29 | my $key_length = 40; # number of chars in each key |
55 | my @chars = @{ $self->{ce}->{sessionKeyChars} }; |
| 30 | my @key_chars = ('A'..'Z', 'a'..'z', '0'..'9', '.', '^', '/', '!', '*'); |
56 | my $length = $self->{ce}->{sessionKeyLength}; |
| 31 | |
|
|
| 32 | my $i = $key_length; |
|
|
| 33 | my $key = ''; |
|
|
| 34 | srand; |
57 | srand; |
| 35 | while($i) { |
58 | my $key = join ("", @chars[map rand(@chars), 1 .. $length]); |
| 36 | $key .= $key_chars[rand(@key_chars)]; |
59 | return WeBWorK::DB::Record::Key->new(user_id=>$userID, key=>$key, timestamp=>time); |
| 37 | $i--; |
60 | } |
|
|
61 | |
|
|
62 | sub checkKey($$$) { |
|
|
63 | my ($self, $userID, $possibleKey) = @_; |
|
|
64 | my $Key = $self->{db}->getKey($userID); # checked |
|
|
65 | return 0 unless defined $Key; |
|
|
66 | if (time <= $Key->timestamp()+$self->{ce}->{sessionKeyTimeout}) { |
|
|
67 | if ($possibleKey eq $Key->key()) { |
|
|
68 | # unexpired and matches -- update timestamp |
|
|
69 | $Key->timestamp(time); |
|
|
70 | $self->{db}->putKey($Key); |
|
|
71 | return 1; |
|
|
72 | } else { |
|
|
73 | # unexpired but doesn't match -- leave timestamp alone |
|
|
74 | # we do this to keep an attacker from keeping someone's session |
|
|
75 | # alive. (yeah, we don't match IPs.) |
|
|
76 | return 0; |
| 38 | } |
77 | } |
|
|
78 | } else { |
|
|
79 | # expired -- delete key |
|
|
80 | $self->{db}->deleteKey($userID); |
| 39 | return $key; |
81 | return 0; |
|
|
82 | } |
|
|
83 | } |
|
|
84 | |
|
|
85 | sub unexpiredKeyExists($$) { |
|
|
86 | my ($self, $userID) = @_; |
|
|
87 | my $Key = $self->{db}->getKey($userID); # checked |
|
|
88 | return 0 unless defined $Key; |
|
|
89 | if (time <= $Key->timestamp()+$self->{ce}->{sessionKeyTimeout}) { |
|
|
90 | # unexpired, but leave timestamp alone |
|
|
91 | return 1; |
|
|
92 | } else { |
|
|
93 | # expired -- delete key |
|
|
94 | $self->{db}->deleteKey($userID); |
|
|
95 | return 0; |
|
|
96 | } |
| 40 | } |
97 | } |
| 41 | |
98 | |
| 42 | # verify will return 1 if the person is who they say the are. |
99 | # verify will return 1 if the person is who they say the are. |
| 43 | # If the verification failed because of of invalid authentication data, |
100 | # If the verification failed because of of invalid authentication data, |
| 44 | # a note will be written in the request explaining why it failed. |
101 | # a note will be written in the request explaining why it failed. |
| … | |
… | |
| 46 | # no note will be written, as this is expected to happen whenever someone |
103 | # no note will be written, as this is expected to happen whenever someone |
| 47 | # types in a URL manually, and is not considered an error condition. |
104 | # types in a URL manually, and is not considered an error condition. |
| 48 | sub verify($) { |
105 | sub verify($) { |
| 49 | my $self = shift; |
106 | my $self = shift; |
| 50 | my $r = $self->{r}; |
107 | my $r = $self->{r}; |
| 51 | my $course_env = $self->{ce}; |
108 | my $ce = $self->{ce}; |
|
|
109 | my $db = $self->{db}; |
|
|
110 | |
|
|
111 | my $practiceUserPrefix = $ce->{practiceUserPrefix}; |
|
|
112 | my $debugPracticeUser = $ce->{debugPracticeUser}; |
| 52 | |
113 | |
| 53 | my $user = $r->param('user'); |
114 | my $user = $r->param('user'); |
| 54 | my $passwd = $r->param('passwd'); |
115 | my $passwd = $r->param('passwd'); |
| 55 | my $key = $r->param('key'); |
116 | my $key = $r->param('key'); |
| 56 | my $time = time; |
117 | my $force_passwd_authen = $r->param('force_passwd_authen'); |
| 57 | |
|
|
| 58 | # I wanted to get rid of that passwd up here for security reasons, |
|
|
| 59 | # but usability dictates that we not clear out invalid passwords. |
|
|
| 60 | #$r->param('passwd',undef); |
|
|
| 61 | |
118 | |
| 62 | my $error; |
119 | my $error; |
| 63 | my $return; |
120 | my $failWithoutError = 0; |
| 64 | |
121 | |
| 65 | my $auth = WeBWorK::DB::Auth->new($course_env); |
122 | VERIFY: { |
| 66 | |
123 | # This block is here so we can "last" out of it when we've |
| 67 | # The first part of this big conditional checks to make that we have |
124 | # decided whether we're going to succeed or fail. |
| 68 | # all of the form info that we need. It's pretty boring. The kooky |
125 | |
| 69 | # authen stuff comes after that. |
126 | # no authentication data was given. this is OK. |
| 70 | if (!defined $user && !defined $passwd && !defined $key) { |
127 | unless (defined $user or defined $passwd or defined $key) { |
| 71 | # The user hasn't even had a chance to say who he is, so we |
128 | $failWithoutError = 1; |
| 72 | # can't hold it against him that we don't know. |
129 | last VERIFY; |
| 73 | undef $error; |
130 | } |
| 74 | $return = 0; |
131 | |
| 75 | } elsif (!$user) { |
132 | if (defined $user and $force_passwd_authen) { |
|
|
133 | $failWithoutError = 1; |
|
|
134 | last VERIFY; |
|
|
135 | } |
|
|
136 | |
|
|
137 | # no user was supplied. somebody's building their own GET |
|
|
138 | unless ($user) { |
| 76 | $error = "You must specify a username"; |
139 | $error = "You must specify a username."; |
| 77 | $return = 0; |
140 | last VERIFY; |
| 78 | } elsif (!$passwd && !$key) { |
|
|
| 79 | $error = "You must enter a password"; |
|
|
| 80 | $return = 0; |
|
|
| 81 | } |
141 | } |
| 82 | # OK, we're done with the trivia. Now lets authenticate. |
142 | |
| 83 | elsif ($passwd) { |
143 | # it's a practice user. |
| 84 | # A bit of extra logic for practice users |
|
|
| 85 | # Practice users are different because: |
|
|
| 86 | # - They aren't allowed to log in if an active key exists |
|
|
| 87 | # (except for $debugPracticeUser) |
|
|
| 88 | # - They are allowed to log in with any password |
|
|
| 89 | my $practiceUserPrefix = $course_env->{"practiceUserPrefix"}; |
|
|
| 90 | my $debugPracticeUser = $course_env->{"debugPracticeUser"}; |
|
|
| 91 | if ($practiceUserPrefix and $user =~ /^$practiceUserPrefix/) { |
144 | if ($practiceUserPrefix and $user =~ /^$practiceUserPrefix/) { |
| 92 | if (!$auth->getPassword($user)) { # the only way DB::Auth provides for checking the existence of a user |
145 | # we're not interested in a practice user's password |
|
|
146 | $r->param("passwd", ""); |
|
|
147 | |
|
|
148 | # it's a practice user that doesn't exist. |
|
|
149 | unless (defined $db->getUser($user)) { # checked |
| 93 | $error = "That practice account does not exist"; |
150 | $error = "That practice account does not exist."; |
| 94 | $return = 0; |
151 | last VERIFY; |
| 95 | } elsif ($auth->getKey($user) and $user ne $debugPracticeUser) { |
152 | } |
|
|
153 | |
|
|
154 | # we've got a key. |
|
|
155 | if ($key) { |
|
|
156 | if ($self->checkKey($user, $key)) { |
|
|
157 | # they key was valid. |
|
|
158 | last VERIFY; |
|
|
159 | } else { |
|
|
160 | # the key was invalid. |
|
|
161 | $error = "Your session has timed out due to inactivity. You must login again."; |
|
|
162 | last VERIFY; |
|
|
163 | } |
|
|
164 | } |
|
|
165 | |
|
|
166 | # -- here we know that a key was not supplied. -- |
|
|
167 | |
|
|
168 | # it's the debug user. |
|
|
169 | if ($debugPracticeUser and $user eq $debugPracticeUser) { |
|
|
170 | # clobber any existing session, valid or not. |
|
|
171 | my $Key = $self->generateKey($user); |
|
|
172 | eval { $db->deleteKey($user) }; |
|
|
173 | $db->addKey($Key); |
|
|
174 | $r->param("key", $Key->key()); |
|
|
175 | last VERIFY; |
|
|
176 | } |
|
|
177 | |
|
|
178 | # an unexpired key exists -- the account is in use. |
|
|
179 | if ($self->unexpiredKeyExists($user)) { |
| 96 | $error = "That practice account is in use"; |
180 | $error = "That practice account is in use."; |
| 97 | $return = 0; |
181 | last VERIFY; |
|
|
182 | } |
|
|
183 | |
|
|
184 | # here we know the account is not in use, so we |
|
|
185 | # generate a new session key (unexpiredKeyExists |
|
|
186 | # deleted any expired key) and succeed! |
|
|
187 | my $Key = $self->generateKey($user); |
|
|
188 | $db->addKey($Key); |
|
|
189 | $r->param("key", $Key->key()); |
|
|
190 | last VERIFY; |
|
|
191 | } |
|
|
192 | |
|
|
193 | # -- here we know it's a regular user. -- |
|
|
194 | |
|
|
195 | # a key was supplied. |
|
|
196 | if ($key) { |
|
|
197 | # we're not interested in a user's password if they're |
|
|
198 | # supplying a key |
|
|
199 | $r->param("passwd", ""); |
|
|
200 | |
|
|
201 | if ($self->checkKey($user, $key)) { |
|
|
202 | # valid key, so succeed. |
|
|
203 | last VERIFY; |
| 98 | } else { |
204 | } else { |
| 99 | $key = generate_key; |
205 | # invalid key. the login page doesn't propogate the key, |
| 100 | $auth->setKey($user, $key); |
206 | # so we know this is an expired session. |
| 101 | $r->param('key',$key); |
207 | $error = "Your session has timed out due to inactivity. You must login again."; |
| 102 | $return = 1; |
208 | last VERIFY; |
| 103 | } |
|
|
| 104 | } |
209 | } |
| 105 | # Not a practice user. Do normal authentication. |
210 | } |
| 106 | elsif ($auth->verifyPassword($user, $passwd)) { |
211 | |
| 107 | # Remove the passwd field from subsequent requests. |
212 | # a password was supplied. |
|
|
213 | if ($passwd) { |
|
|
214 | if ($self->checkPassword($user, $passwd)) { |
|
|
215 | # valid password, so create a new session. (we don't want |
|
|
216 | # to reuse an old one, duh.) |
|
|
217 | my $Key = $self->generateKey($user); |
|
|
218 | eval { $db->deleteKey($user) }; |
|
|
219 | $db->addKey($Key); |
|
|
220 | $r->param("key", $Key->key()); |
|
|
221 | # also delete the password |
| 108 | $r->param('passwd',""); |
222 | $r->param("passwd", ""); |
| 109 | $key = $auth->getKey($user) || generate_key; |
223 | last VERIFY; |
| 110 | $auth->setKey($user, $key); |
|
|
| 111 | $r->param('key',$key); |
|
|
| 112 | $return = 1; |
|
|
| 113 | } else { |
224 | } else { |
|
|
225 | # incorrect password. fail. |
| 114 | $error = "Incorrect username or password"; |
226 | $error = "Incorrect username or password."; |
| 115 | $return = 0; |
227 | last VERIFY; |
| 116 | } |
228 | } |
| 117 | } elsif ($key) { |
229 | } |
| 118 | # The timestamp gets updated by verifyKey |
230 | |
| 119 | if ($auth->verifyKey($user, $key)) { |
231 | # neither a key or a password were supplied. |
| 120 | $return = 1; |
232 | $error = "You must enter a password." |
| 121 | } else { |
233 | } |
| 122 | $error = "Your session has expired. You must login again"; |
234 | |
|
|
235 | if (defined $error) { |
|
|
236 | $r->notes("authen_error",$error); |
| 123 | $return = 0; |
237 | return 0; |
| 124 | } |
|
|
| 125 | } else { |
238 | } else { |
| 126 | $error = "Unexpected authentication error!"; |
239 | return not $failWithoutError; |
| 127 | $return = 0; |
|
|
| 128 | } |
240 | } |
| 129 | |
|
|
| 130 | $r->notes("authen_error",$error) if defined($error); |
|
|
| 131 | return $return; |
|
|
| 132 | |
241 | |
| 133 | # Whatever you do, don't delete this! |
242 | # Whatever you do, don't delete this! |
| 134 | critical($r); |
243 | critical($r); |
| 135 | } |
244 | } |
| 136 | |
245 | |
| … | |
… | |
| 138 | |
247 | |
| 139 | __END__ |
248 | __END__ |
| 140 | |
249 | |
| 141 | =head1 AUTHOR |
250 | =head1 AUTHOR |
| 142 | |
251 | |
| 143 | Written by Dennis Lambe Jr., malsyned (at) math.rochester.edu |
252 | Written by Dennis Lambe Jr., malsyned (at) math.rochester.edu, and Sam Hathaway, sh002i (at) math.rochester.edu. |
| 144 | |
253 | |
| 145 | =cut |
254 | =cut |