[system] / trunk / webwork / system / lib / Auth.pm Repository:
ViewVC logotype

View of /trunk/webwork/system/lib/Auth.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 51 - (download) (as text) (annotate)
Thu Jun 21 20:53:03 2001 UTC (18 years, 8 months ago) by sam
File size: 10324 byte(s)
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