Parent Directory
| 
Revision Log
Fixed headers to include $Id$
1 #!/usr/local/bin/perl 2 3 ################################################################################ 4 # WeBWorK 5 # 6 # Copyright (c) 1995-2001 University of Rochester 7 # All rights reserved 8 # 9 # $Id$ 10 ################################################################################ 11 12 package Auth; 13 14 require 5.000; 15 require Exporter; 16 @ISA = qw(Exporter); 17 @EXPORT = qw( 18 verify_password 19 new_password 20 change_user_in_password_file 21 get_password 22 delete_password 23 verify_key 24 new_key 25 delete_key 26 get_permissions 27 put_permissions 28 change_user_in_permissions_file 29 delete_permissions 30 create_db 31 get_keys_from_db 32 get_hash_from_db 33 get_active_users_from_keysDB 34 get_current_users_from_passwordDB 35 ); 36 37 use Global; 38 39 my $Timeout = 3600; # key expires after 3600 seconds (60min) 40 my $Key_length = 40; # number of chars in each key 41 42 my @Key_chars = ('A'..'Z', 'a'..'z', '0'..'9', '.', '^', '/', '!', '*'); 43 my @Salt_chars = ('.', '/', 'A'..'Z', 'a'..'z', '0'..'9'); 44 45 my $cgiURL = &Global::getWebworkCgiURL(); 46 47 ####### public routines (exported into Global's namespace) ###### 48 49 sub get_password { 50 my ($user, $pw_file) = @_; 51 my %pwhash; 52 my $pw_obj; 53 54 &Global::tie_hash('PW_FH',\$pw_obj,\%pwhash, $pw_file,'R',$Global::standard_tie_permission); 55 $return_pw = $pwhash{$user}; 56 &Global::untie_hash('PW_FH',\$pw_obj,\%pwhash, $pw_file); 57 return($return_pw); 58 } 59 60 sub verify_password { 61 my($user, $pw_to_check, $pw_file) = @_; 62 my %pwhash; 63 my $pw_obj; 64 65 &Global::tie_hash('PW_FH',\$pw_obj,\%pwhash, $pw_file,'R',$Global::standard_tie_permission); 66 my $pw = $pwhash{$user}; 67 &Global::untie_hash('PW_FH',\$pw_obj,\%pwhash, $pw_file); 68 69 ## practice user needs no password, but must have password entry at least 70 return 1 if ($pw && $user =~ /^$Global::practiceUser/); 71 72 my $salt = substr($pw, 0, 2); 73 74 ## There's a problem if password entry doesn't exist for user 75 ## or passwords don't match 76 77 return 0 if (!$pw) || (crypt($pw_to_check, $salt) ne $pw); 78 79 ## otherwise the password's good 80 return 1; 81 } 82 83 sub new_password { 84 my($user, $new_pw, $pw_file) = @_; 85 my %pwhash; 86 my $pw_obj; 87 88 $encrypted_pw = crypt($new_pw, &new_salt); 89 90 &Global::tie_hash('PW_FH',\$pw_obj,\%pwhash, $pw_file,'W',$Global::standard_tie_permission); 91 $pwhash{$user} = $encrypted_pw; 92 &Global::untie_hash('PW_FH',\$pw_obj,\%pwhash, $pw_file); 93 return 1; 94 } 95 96 97 sub change_user_in_password_file{ 98 my($new_user, $old_user, $pw_file) = @_; 99 my %pwhash; 100 my $pw_obj; 101 102 &Global::tie_hash('PW_FH',\$pw_obj,\%pwhash, $pw_file,'W',$Global::standard_tie_permission); 103 if (defined $pwhash{$old_user}) { 104 $pwhash{$new_user} = $pwhash{$old_user}; 105 delete $pwhash{$old_user}; 106 } 107 &Global::untie_hash('PW_FH',\$pw_obj,\%pwhash, $pw_file); 108 return 1; 109 } 110 111 112 113 sub delete_password { 114 my($user, $pw_file) = @_; 115 my %pwhash; 116 my $pw_obj; 117 118 &Global::tie_hash('PW_FH',\$pw_obj,\%pwhash, $pw_file,'W',$Global::standard_tie_permission); 119 delete $pwhash{$user}; 120 &Global::untie_hash('PW_FH',\$pw_obj,\%pwhash, $pw_file); 121 return 1; 122 } 123 124 125 sub verify_key { 126 my($user, $key_to_check, $key_file, $course, $rh_inputs) = @_; 127 ## Don't check the session key for a "practice" user 128 ## return 1 if ($user =~ /^$Global::practiceUser/); 129 130 ## check to see if $key_to_check matches $key in $key_file. 131 132 my($key, $timestamp, $elapsed_time, $tries); 133 my %keyhash; 134 my $key_obj; 135 136 &Global::tie_hash('KEY_FH',\$key_obj,\%keyhash, $key_file,'W',$Global::restricted_tie_permission); 137 ($key, $timestamp) = split(/\s+/, $keyhash{$user}); 138 $elapsed_time = time - $timestamp; 139 140 if ((!$key) ## no key in database for user? 141 || ($key_to_check ne $key) ## key_to_check doesn't match real key? 142 || ($elapsed_time > $Timeout)) ## key is too old? 143 { 144 &Global::untie_hash('KEY_FH',\$key_obj,\%keyhash, $key_file); 145 # send user back to login script 146 &login_again_form($course,$rh_inputs); 147 exit 0; 148 } 149 150 ## key is valid: update timestamp 151 152 $timestamp = time; 153 $keyhash{$user} = "$key $timestamp"; 154 155 &Global::untie_hash('KEY_FH',\$key_obj,\%keyhash, $key_file); 156 return 1; 157 } 158 159 sub new_key { 160 local($user, $key_file) = @_; 161 ## Don't generate a key for a "practice" user 162 ##return $Global::practiceKey if $user eq $Global::practiceUser; 163 164 ## create a new key for $user in $key_file 165 166 my($i, $key, $timestamp); 167 my %keyhash; 168 my $key_obj; 169 170 &Global::tie_hash('KEY_FH',\$key_obj,\%keyhash, $key_file,'W',$Global::restricted_tie_permission); 171 172 ## generate key 173 $key = &generate_key; 174 175 $timestamp = time; 176 $keyhash{$user} = "$key $timestamp"; 177 &Global::untie_hash('KEY_FH',\$key_obj,\%keyhash, $key_file); 178 return($key); 179 } 180 181 sub delete_key { 182 my($user, $key_file) = @_; 183 my %keyhash; 184 my $key_obj; 185 186 &Global::tie_hash('KEY_FH',\$key_obj,\%keyhash, $key_file,'W',$Global::restricted_tie_permission); 187 delete $keyhash{$user}; 188 &Global::untie_hash('KEY_FH',\$key_obj,\%keyhash, $key_file); 189 return 1; 190 } 191 192 193 sub get_permissions { 194 my ($user, $perm_file) = @_; 195 my %permhash; 196 my $perm_obj; 197 198 &Global::tie_hash('PERM_FILE',\$perm_obj,\%perm_hash, $perm_file,'R',$Global::standard_tie_permission); 199 $return_perm = $perm_hash{$user}; 200 &Global::untie_hash('PERM_FILE',\$perm_obj,\%perm_hash, $perm_file); 201 return($return_perm); 202 } 203 204 sub put_permissions { 205 my( $new_perm, $user, $perm_file) = @_; 206 my %perm_hash; 207 my $perm_obj; 208 209 210 &Global::tie_hash('PERM_FILE',\$perm_obj,\%perm_hash, $perm_file,'W',$Global::standard_tie_permission); 211 $perm_hash{$user} = $new_perm; 212 &Global::untie_hash('PERM_FILE',\$perm_obj,\%perm_hash, $perm_file); 213 return 1; 214 } 215 216 sub change_user_in_permissions_file{ 217 my($new_user, $old_user, $perm_file) = @_; 218 my %perm_hash; 219 my $perm_obj; 220 221 &Global::tie_hash('PERM_FILE',\$perm_obj,\%perm_hash, $perm_file,'W',$Global::standard_tie_permission); 222 if (defined $perm_hash{$old_user}) { 223 $perm_hash{$new_user} = $perm_hash{$old_user}; 224 delete $perm_hash{$old_user}; 225 } 226 &Global::untie_hash('PERM_FILE',\$perm_obj,\%perm_hash, $perm_file); 227 return 1; 228 } 229 230 231 232 sub delete_permissions { 233 my($user, $perm_file) = @_; 234 my %perm_hash; 235 my $perm_obj; 236 237 &Global::tie_hash('PERM_FILE',\$perm_obj,\%perm_hash, $perm_file,'W',$Global::standard_tie_permission); 238 delete $perm_hash{$user}; 239 &Global::untie_hash('PERM_FILE',\$perm_obj,\%perm_hash, $perm_file); 240 return 1; 241 } 242 243 sub create_db { 244 my ($fileName, $permissions) =@_; 245 my %pwhash; 246 my $pw_obj; 247 &Global::tie_hash('PW_FH',\$pw_obj,\%pwhash, $fileName,'W',$permissions); 248 &Global::untie_hash('PW_FH',\$pw_obj,\%pwhash, $fileName); 249 250 chmod($permissions, $fileName) or 251 wwerror($0, "Can't do chmod($permissions, $fileName)"); 252 chown(-1,$Global::numericalGroupID,$fileName) or 253 wwerror($0, "Can't do chown(-1,$Global::numericalGroupID,$fileName)"); 254 255 } 256 257 sub get_keys_from_db { 258 my ($fileName) =@_; 259 my %pwhash; 260 my $pw_obj; 261 &Global::tie_hash('PW_FH',\$pw_obj,\%pwhash, $fileName,'R',$Global::standard_tie_permission); 262 my @keysArray = keys(%pwhash); 263 &Global::untie_hash('PW_FH',\$pw_obj,\%pwhash, $fileName); 264 @keysArray; 265 } 266 267 sub get_hash_from_db { 268 my ($fileName) =@_; 269 my %dbhash; 270 my $db_obj; 271 &Global::tie_hash('PW_FH',\$db_obj,\%dbhash, $fileName,'R',$Global::standard_tie_permission); 272 my %outhash = %dbhash; 273 &Global::untie_hash('PW_FH',\$db_obj,\%dbhash, $fileName); 274 %outhash; 275 } 276 277 278 sub get_active_users_from_keysDB { 279 my($key_file) = @_; 280 281 ## check to see if $key_to_check matches $key in $key_file. 282 283 my($user, $key, $timestamp, $elapsed_time, $tries); 284 my %keyhash; 285 my $key_obj; 286 my @activelist =(); 287 288 &Global::tie_hash('KEY_FH',\$key_obj,\%keyhash, $key_file,'R',$Global::restricted_tie_permission); 289 290 foreach $user (keys %keyhash) { 291 ($key, $timestamp) = split(/\s+/, $keyhash{$user}); 292 $elapsed_time = time - $timestamp; 293 if ( $elapsed_time < $Timeout) { push @activelist, $user;} 294 } 295 &Global::untie_hash('KEY_FH',\$key_obj,\%keyhash, $key_file); 296 @activelist; 297 } 298 299 sub get_current_users_from_passwordDB { 300 my ($pw_file) = @_; 301 my %pwhash; 302 my $pw_obj; 303 my $user; 304 my @currentlist =(); 305 306 &Global::tie_hash('PW_FH',\$pw_obj,\%pwhash, $pw_file,'R',$Global::standard_tie_permission); 307 foreach $user (keys %pwhash) {push @currentlist, $user;} 308 &Global::untie_hash('PW_FH',\$pw_obj,\%pwhash, $pw_file); 309 @currentlist; 310 } 311 312 313 314 315 316 ####### private routines ####### 317 318 sub new_salt {srand; $Salt_chars[rand(@Salt_chars)] . $Salt_chars[rand(@Salt_chars)]}; 319 320 sub generate_key { 321 my $i = $Key_length; 322 my $key = ''; 323 srand; 324 while($i) { 325 $key .= $Key_chars[rand(@Key_chars)]; 326 $i--; 327 } 328 return $key; 329 } 330 331 332 333 334 335 sub login_again_form { 336 my $course = shift; 337 my $rh_inputs =shift; 338 my %inputs; # try to find information for fast relogin 339 if ( defined($rh_inputs) ) { 340 %inputs = %{$rh_inputs}; 341 } elsif (defined(%main::in)) { 342 %inputs = %main::in; 343 } else { 344 %inputs = (); 345 } 346 print <<End_Of_Form; 347 content-type: text/html 348 349 <HEAD><TITLE></TITLE></HEAD> 350 <BODY BACKGROUND="$Global::background_warn_url"> 351 <H1>Not Logged In</H1> 352 Sorry, you have been logged out, probably due to excessive idle time.<br> 353 To continue you will have to log in again. 354 <FORM ACTION="$Global::loginURL"> 355 <INPUT TYPE="HIDDEN" NAME="course" VALUE="$course"> 356 <INPUT TYPE="SUBMIT" VALUE="Login"> 357 </FORM> 358 359 360 End_Of_Form 361 362 print <<End_Of_Text; 363 <HR><H2> Fast relogin for $inputs{'user'}</H2> 364 Type your password and click "Go". You will be returned to where you were in your problem set. 365 <FORM ACTION="${cgiURL}login.pl" METHOD="POST"> 366 End_Of_Text 367 # print a fast login form. Copy all of the hidden variable except for the one named 'key' 368 my $tmp_key; 369 foreach $tmp_key (keys %inputs) { 370 next if $tmp_key eq 'key'; 371 print qq!<INPUT TYPE="HIDDEN" NAME="$tmp_key" VALUE ="$inputs{$tmp_key}">\n!; 372 } 373 print qq!<INPUT TYPE="HIDDEN" NAME="SCRIPTING_FILE" VALUE="$ENV{'SCRIPT_NAME'}">\n!; 374 print qq!Password:<INPUT TYPE=PASSWORD NAME="passwd" VALUE = "">\n!; 375 print "<INPUT TYPE=SUBMIT NAME=\"GO\" VALUE=\"GO\">\n</FORM>"; 376 print "\n</BODY>"; 377 } 378 379
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |