[system] / branches / rel-2-1-a1 / webwork-modperl / lib / WeBWorK / Authen.pm Repository:
ViewVC logotype

Diff of /branches/rel-2-1-a1/webwork-modperl/lib/WeBWorK/Authen.pm

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

Revision 809 Revision 1663
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
6package WeBWorK::Authen; 17package WeBWorK::Authen;
7 18
8=head1 NAME 19=head1 NAME
11 22
12=cut 23=cut
13 24
14use strict; 25use strict;
15use warnings; 26use warnings;
16use WeBWorK::DB::Auth;
17 27
18sub new($$$) { 28sub 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
45sub 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
27sub generate_key { 53sub 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
62sub 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
85sub 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.
48sub verify($) { 105sub 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
143Written by Dennis Lambe Jr., malsyned (at) math.rochester.edu 252Written by Dennis Lambe Jr., malsyned (at) math.rochester.edu, and Sam Hathaway, sh002i (at) math.rochester.edu.
144 253
145=cut 254=cut

Legend:
Removed from v.809  
changed lines
  Added in v.1663

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9