Parent Directory
| 
Revision Log
Revision 51 - (view) (download) (as text)
| 1 : | sam | 10 | #!/usr/local/bin/perl |
| 2 : | sam | 2 | |
| 3 : | sam | 51 | ################################################################################ |
| 4 : | # WeBWorK | ||
| 5 : | # | ||
| 6 : | # Copyright (c) 1995-2001 University of Rochester | ||
| 7 : | # All rights reserved | ||
| 8 : | # | ||
| 9 : | # $Id$ | ||
| 10 : | ################################################################################ | ||
| 11 : | |||
| 12 : | sam | 2 | 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 |