[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 10 - (download) (as text) (annotate)
Fri Jun 15 21:06:18 2001 UTC (12 years, 10 months ago) by sam
File size: 10285 byte(s)
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