#!/usr/local/bin/perl

################################################################################
# WeBWorK
# 
# Copyright (c) 1995-2001 University of Rochester
# All rights reserved
# 
# $Id$
################################################################################

package Auth;

require 5.000;
require Exporter;
@ISA = qw(Exporter);
@EXPORT = qw(
verify_password
new_password
change_user_in_password_file
get_password
delete_password
verify_key
new_key
delete_key
get_permissions
put_permissions
change_user_in_permissions_file
delete_permissions
create_db
get_keys_from_db
get_hash_from_db
get_active_users_from_keysDB
get_current_users_from_passwordDB
);

use Global;

my $Timeout        = 3600;			# key expires after 3600 seconds (60min)
my $Key_length	= 40;			# number of chars in each key

my @Key_chars      = ('A'..'Z', 'a'..'z', '0'..'9', '.', '^', '/', '!', '*');
my @Salt_chars	= ('.', '/', 'A'..'Z', 'a'..'z', '0'..'9');

my $cgiURL = &Global::getWebworkCgiURL();

####### public routines (exported into Global's namespace) ######

sub get_password {
    my ($user, $pw_file) = @_;
    my %pwhash;
    my $pw_obj;

    &Global::tie_hash('PW_FH',\$pw_obj,\%pwhash, $pw_file,'R',$Global::standard_tie_permission);
    $return_pw = $pwhash{$user};
    &Global::untie_hash('PW_FH',\$pw_obj,\%pwhash, $pw_file);
    return($return_pw);
}

sub verify_password {
    my($user, $pw_to_check, $pw_file) = @_;
    my %pwhash;
    my $pw_obj;

    &Global::tie_hash('PW_FH',\$pw_obj,\%pwhash, $pw_file,'R',$Global::standard_tie_permission);
    my $pw = $pwhash{$user};
    &Global::untie_hash('PW_FH',\$pw_obj,\%pwhash, $pw_file);

    ## practice user needs no password, but must have password entry at least
    return 1 if ($pw && $user =~ /^$Global::practiceUser/);

    my $salt = substr($pw, 0, 2);

    ## There's a problem if password entry doesn't exist for user
    ## or passwords don't match

    return 0 if (!$pw) || (crypt($pw_to_check, $salt) ne $pw);

    ## otherwise the password's good
    return 1;
}

sub new_password {
    my($user, $new_pw, $pw_file) = @_;
    my %pwhash;
    my $pw_obj;

    $encrypted_pw = crypt($new_pw, &new_salt);

    &Global::tie_hash('PW_FH',\$pw_obj,\%pwhash, $pw_file,'W',$Global::standard_tie_permission);
    $pwhash{$user} = $encrypted_pw;
    &Global::untie_hash('PW_FH',\$pw_obj,\%pwhash, $pw_file);
    return 1;
}


sub change_user_in_password_file{
    my($new_user, $old_user, $pw_file) = @_;
    my %pwhash;
    my $pw_obj;

    &Global::tie_hash('PW_FH',\$pw_obj,\%pwhash, $pw_file,'W',$Global::standard_tie_permission);
    if (defined $pwhash{$old_user}) {
    	$pwhash{$new_user} = $pwhash{$old_user};
		delete $pwhash{$old_user};
	}
    &Global::untie_hash('PW_FH',\$pw_obj,\%pwhash, $pw_file);
    return 1;
}



sub delete_password {
    my($user, $pw_file) = @_;
    my %pwhash;
    my $pw_obj;

    &Global::tie_hash('PW_FH',\$pw_obj,\%pwhash, $pw_file,'W',$Global::standard_tie_permission);
    delete $pwhash{$user};
    &Global::untie_hash('PW_FH',\$pw_obj,\%pwhash, $pw_file);
    return 1;
}


sub verify_key {
    my($user, $key_to_check, $key_file, $course, $rh_inputs) = @_;
  ## Don't check the session key for a "practice" user
  ## return 1 if ($user =~ /^$Global::practiceUser/);

  ## check to see if $key_to_check matches $key in $key_file.

    my($key, $timestamp, $elapsed_time, $tries);
    my %keyhash;
    my $key_obj;

    &Global::tie_hash('KEY_FH',\$key_obj,\%keyhash, $key_file,'W',$Global::restricted_tie_permission);
    ($key, $timestamp) = split(/\s+/, $keyhash{$user});
    $elapsed_time = time - $timestamp;

    if ((!$key)                       ## no key in database for user?
       || ($key_to_check ne $key)     ## key_to_check doesn't match real key?
       || ($elapsed_time > $Timeout)) ## key is too old?
    {
	&Global::untie_hash('KEY_FH',\$key_obj,\%keyhash, $key_file);
	# send user back to login script
 	&login_again_form($course,$rh_inputs);
	exit 0;
    }

  ## key is valid: update timestamp

    $timestamp = time;
    $keyhash{$user} = "$key $timestamp";

    &Global::untie_hash('KEY_FH',\$key_obj,\%keyhash, $key_file);
    return 1;
}

sub new_key {
    local($user, $key_file) = @_;
  ## Don't generate a key for a "practice" user
  ##return $Global::practiceKey if $user eq $Global::practiceUser;

  ## create a new key for $user in $key_file

    my($i, $key, $timestamp);
    my %keyhash;
    my $key_obj;

    &Global::tie_hash('KEY_FH',\$key_obj,\%keyhash, $key_file,'W',$Global::restricted_tie_permission);

    ## generate key
    $key = &generate_key;

    $timestamp = time;
    $keyhash{$user} = "$key $timestamp";
    &Global::untie_hash('KEY_FH',\$key_obj,\%keyhash, $key_file);
    return($key);
}

sub delete_key {
    my($user, $key_file) = @_;
    my %keyhash;
    my $key_obj;

    &Global::tie_hash('KEY_FH',\$key_obj,\%keyhash, $key_file,'W',$Global::restricted_tie_permission);
    delete $keyhash{$user};
    &Global::untie_hash('KEY_FH',\$key_obj,\%keyhash, $key_file);
    return 1;
}


sub get_permissions {
    my ($user, $perm_file) = @_;
    my %permhash;
    my $perm_obj;

    &Global::tie_hash('PERM_FILE',\$perm_obj,\%perm_hash, $perm_file,'R',$Global::standard_tie_permission);
    $return_perm = $perm_hash{$user};
    &Global::untie_hash('PERM_FILE',\$perm_obj,\%perm_hash, $perm_file);
    return($return_perm);
}

sub put_permissions {
    my( $new_perm, $user, $perm_file) = @_;
    my %perm_hash;
    my $perm_obj;


    &Global::tie_hash('PERM_FILE',\$perm_obj,\%perm_hash, $perm_file,'W',$Global::standard_tie_permission);
    $perm_hash{$user} = $new_perm;
    &Global::untie_hash('PERM_FILE',\$perm_obj,\%perm_hash, $perm_file);
    return 1;
}

sub change_user_in_permissions_file{
    my($new_user, $old_user, $perm_file) = @_;
    my %perm_hash;
    my $perm_obj;

    &Global::tie_hash('PERM_FILE',\$perm_obj,\%perm_hash, $perm_file,'W',$Global::standard_tie_permission);
    if (defined $perm_hash{$old_user}) {
    	$perm_hash{$new_user} = $perm_hash{$old_user};
		delete $perm_hash{$old_user};
	}
    &Global::untie_hash('PERM_FILE',\$perm_obj,\%perm_hash, $perm_file);
    return 1;
}



sub delete_permissions {
    my($user, $perm_file) = @_;
    my %perm_hash;
    my $perm_obj;

    &Global::tie_hash('PERM_FILE',\$perm_obj,\%perm_hash, $perm_file,'W',$Global::standard_tie_permission);
    delete $perm_hash{$user};
    &Global::untie_hash('PERM_FILE',\$perm_obj,\%perm_hash, $perm_file);
    return 1;
}

sub create_db {
    my ($fileName, $permissions) =@_;
    my %pwhash;
    my $pw_obj;
    &Global::tie_hash('PW_FH',\$pw_obj,\%pwhash, $fileName,'W',$permissions);
    &Global::untie_hash('PW_FH',\$pw_obj,\%pwhash, $fileName);

    chmod($permissions, $fileName) or
                             wwerror($0, "Can't do chmod($permissions, $fileName)");
    chown(-1,$Global::numericalGroupID,$fileName)  or
                             wwerror($0, "Can't do chown(-1,$Global::numericalGroupID,$fileName)");

}

sub get_keys_from_db {
    my ($fileName) =@_;
    my %pwhash;
    my $pw_obj;
    &Global::tie_hash('PW_FH',\$pw_obj,\%pwhash, $fileName,'R',$Global::standard_tie_permission);
    my @keysArray = keys(%pwhash);
    &Global::untie_hash('PW_FH',\$pw_obj,\%pwhash, $fileName);
    @keysArray;
}

sub get_hash_from_db {
    my ($fileName) =@_;
    my %dbhash;
    my $db_obj;
    &Global::tie_hash('PW_FH',\$db_obj,\%dbhash, $fileName,'R',$Global::standard_tie_permission);
    my %outhash = %dbhash;
    &Global::untie_hash('PW_FH',\$db_obj,\%dbhash, $fileName);
    %outhash;
}


sub get_active_users_from_keysDB {
    my($key_file) = @_;

  ## check to see if $key_to_check matches $key in $key_file.

    my($user, $key, $timestamp, $elapsed_time, $tries);
    my %keyhash;
    my $key_obj;
    my @activelist =();

    &Global::tie_hash('KEY_FH',\$key_obj,\%keyhash, $key_file,'R',$Global::restricted_tie_permission);

    foreach $user (keys %keyhash) {
        ($key, $timestamp) = split(/\s+/, $keyhash{$user});
        $elapsed_time = time - $timestamp;
        if ( $elapsed_time < $Timeout) { push @activelist, $user;}
    }
    &Global::untie_hash('KEY_FH',\$key_obj,\%keyhash, $key_file);
    @activelist;
}

sub get_current_users_from_passwordDB {
    my ($pw_file) = @_;
    my %pwhash;
    my $pw_obj;
    my $user;
    my @currentlist =();

    &Global::tie_hash('PW_FH',\$pw_obj,\%pwhash, $pw_file,'R',$Global::standard_tie_permission);
    foreach $user (keys %pwhash) {push @currentlist, $user;}
    &Global::untie_hash('PW_FH',\$pw_obj,\%pwhash, $pw_file);
    @currentlist;
}





####### private routines #######

sub new_salt {srand; $Salt_chars[rand(@Salt_chars)] . $Salt_chars[rand(@Salt_chars)]};

sub generate_key  {
    my $i = $Key_length;
    my $key = '';
    srand;
    while($i) {
	$key .= $Key_chars[rand(@Key_chars)];
	$i--;
    }
    return $key;
}





sub login_again_form {
    my $course = shift;
    my $rh_inputs =shift;
    my %inputs; # try to find information for fast relogin
    if ( defined($rh_inputs) ) {
   		%inputs = %{$rh_inputs};
   	} elsif (defined(%main::in)) {
   		%inputs = %main::in;
   	} else {
   		%inputs = ();
   	}
print <<End_Of_Form;
content-type: text/html

<HEAD><TITLE></TITLE></HEAD>
<BODY BACKGROUND="$Global::background_warn_url">
<H1>Not Logged In</H1>
Sorry, you have been logged out, probably due to excessive idle time.<br>
To continue you will have to log in again.
<FORM ACTION="$Global::loginURL">
    <INPUT TYPE="HIDDEN" NAME="course" VALUE="$course">
    <INPUT TYPE="SUBMIT" VALUE="Login">
</FORM>


End_Of_Form

print <<End_Of_Text;
<HR><H2> Fast relogin for $inputs{'user'}</H2>
Type your password and click "Go".  You will be returned to where you were in your problem set.
<FORM ACTION="${cgiURL}login.pl" METHOD="POST">
End_Of_Text
#  print a fast login form.  Copy all of the hidden variable except for the one named 'key'
my $tmp_key;
foreach $tmp_key (keys %inputs) {
	next if $tmp_key eq 'key';
	print qq!<INPUT TYPE="HIDDEN" NAME="$tmp_key" VALUE ="$inputs{$tmp_key}">\n!;
}
print qq!<INPUT TYPE="HIDDEN" NAME="SCRIPTING_FILE" VALUE="$ENV{'SCRIPT_NAME'}">\n!;
print qq!Password:<INPUT TYPE=PASSWORD NAME="passwd" VALUE = "">\n!;
print "<INPUT TYPE=SUBMIT NAME=\"GO\" VALUE=\"GO\">\n</FORM>";
print "\n</BODY>";
}