View of /trunk/webwork-modperl/lib/WeBWorK/DB/Auth.pm

    1 ################################################################################
    2 # WeBWorK mod_perl (c) 2000-2002 WeBWorK Project
    3 # $Id$
    4 ################################################################################
    5 
    6 package WeBWorK::DB::Auth;
    7 
    8 =head1 NAME
    9 
   10 WeBWorK::DB::Auth - interface with the WeBWorK authentication/authorization
   11 databases.
   12 
   13 =cut
   14 
   15 use strict;
   16 use warnings;
   17 # there should be a `use' line for each database type
   18 use WeBWorK::DB::GDBM;
   19 
   20 # new($invocant, $courseEnv)
   21 # $invocant implicitly set by caller
   22 # $courseEnv  an instance of CourseEnvironment
   23 sub new($$) {
   24   my $invocant = shift;
   25   my $class = ref($invocant) || $invocant;
   26   my $courseEnv = shift;
   27   my $dbModule = fullyQualifiedPackageName($courseEnv->{dbInfo}->{auth_type});
   28   my $self = {
   29     password_file    => $courseEnv->{dbInfo}->{auth_passwd_file},
   30     permissions_file => $courseEnv->{dbInfo}->{auth_perm_file},
   31     keys_file        => $courseEnv->{dbInfo}->{auth_keys_file},
   32     key_timeout      => $courseEnv->{sessionKeyTimeout},
   33     permission_hash  => $courseEnv->{permissionLevels},
   34   };
   35   $self->{password_db}    = $dbModule->new($self->{password_file});
   36   $self->{permissions_db} = $dbModule->new($self->{permissions_file});
   37   $self->{keys_db}        = $dbModule->new($self->{keys_file});
   38   bless $self, $class;
   39   return $self;
   40 }
   41 
   42 sub fullyQualifiedPackageName($) {
   43   my $n = shift;
   44   my $package = __PACKAGE__;
   45   $package =~ s/([^:]*)$/$n/;
   46   return $package;
   47 }
   48 
   49 # -----
   50 
   51 sub getUsers($) {
   52   my $self = shift;
   53   my %all_users;
   54   if ($self->{password_db}->connect("ro")) {
   55     $all_users{$_}++ foreach keys %{$self->{password_db}->hashRef};
   56     $self->{password_db}->disconnect;
   57   }
   58   if ($self->{permissions_db}->connect("ro")) {
   59     $all_users{$_}++ foreach keys %{$self->{permissions_db}->hashRef};
   60     $self->{permissions_db}->disconnect;
   61   }
   62   if ($self->{keys_db}->connect("ro")) {
   63     $all_users{$_}++ foreach keys %{$self->{keys_db}->hashRef};
   64     $self->{keys_db}->disconnect;
   65   }
   66   return keys %all_users;
   67 }
   68 
   69 # -----
   70 
   71 sub getPassword($$) {
   72   my $self = shift;
   73   my $user = shift;
   74   return unless $self->{password_db}->connect("ro");
   75   my $result = $self->{password_db}->hashRef->{$user};
   76   $self->{password_db}->disconnect;
   77   return $result;
   78 }
   79 
   80 sub setPassword($$$) {
   81   my $self = shift;
   82   my $user = shift;
   83   my $password = crypt shift, join "", ('.','/','0'..'9','A'..'Z','a'..'z')[rand 64, rand 64];
   84   $self->{password_db}->connect("rw");
   85   $self->{password_db}->hashRef->{$user} = $password;
   86   $self->{password_db}->disconnect;
   87 }
   88 
   89 sub verifyPassword($$$) {
   90   my $self = shift;
   91   my $user = shift;
   92   my $password = shift;
   93   my $real_password = $self->getPassword($user);
   94   return unless defined $real_password;
   95   $password = crypt $password, $real_password;
   96   return $password eq $real_password;
   97 }
   98 
   99 sub deletePassword($$) {
  100   my $self = shift;
  101   my $user = shift;
  102   $self->{password_db}->connect("rw");
  103   delete $self->{password_db}->hashRef->{$user};
  104   $self->{password_db}->disconnect;
  105 }
  106 
  107 # -----
  108 
  109 sub getKey($$) {
  110   my $self = shift;
  111   my $user = shift;
  112   return unless $self->{keys_db}->connect("ro");
  113   my $result = $self->{keys_db}->hashRef->{$user};
  114   $self->{keys_db}->disconnect;
  115   my ($key, $timestamp) = defined $result ? split /\s+/, $result : (undef, 0);
  116   if (time <= $timestamp+$self->{key_timeout}) {
  117     return $key;
  118   } else {
  119     $self->deleteKey($user);
  120     return 0;
  121   }
  122 }
  123 
  124 sub setKey($$$) {
  125   my $self = shift;
  126   my $user = shift;
  127   my $key = shift;
  128   $self->{keys_db}->connect("rw");
  129   $self->{keys_db}->hashRef->{$user} = "$key " . time;
  130   $self->{keys_db}->disconnect;
  131 }
  132 
  133 sub verifyKey($$$) {
  134   my $self = shift;
  135   my $user = shift;
  136   my $key = shift;
  137   my $real_key = $self->getKey($user);
  138   return unless defined $real_key;
  139   if ($key eq $real_key) {
  140     # update timestamp
  141     $self->setKey($user, $real_key);
  142     return 1;
  143   } else {
  144     return 0;
  145   }
  146 }
  147 
  148 sub deleteKey($$) {
  149   my $self = shift;
  150   my $user = shift;
  151   $self->{keys_db}->connect("rw");
  152   delete $self->{keys_db}->hashRef->{$user};
  153   $self->{keys_db}->disconnect;
  154 }
  155 
  156 # -----
  157 
  158 sub getPermissions($$) {
  159   my $self = shift;
  160   my $user = shift;
  161   return unless defined $user;
  162   return unless $self->{permissions_db}->connect("ro");
  163   my $result = $self->{permissions_db}->hashRef->{$user};
  164   $self->{permissions_db}->disconnect;
  165   return $result;
  166 }
  167 
  168 sub setPermissions($$$) {
  169   my $self = shift;
  170   my $user = shift;
  171   my $permissions = shift;
  172   return unless defined $user and $permissions;
  173   $self->{permissions_db}->connect("rw");
  174   $self->{permissions_db}->hashRef->{$user} = $permissions;
  175   $self->{permissions_db}->disconnect;
  176 }
  177 
  178 sub deletePermissions($$) {
  179   my $self = shift;
  180   my $user = shift;
  181   return unless defined $user;
  182   $self->{permissions_db}->connect("rw");
  183   delete $self->{permissions_db}->hashRef->{$user};
  184   $self->{permissions_db}->disconnect;
  185 }
  186 
  187 1;