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