[system] / branches / wheeler / webwork2 / lib / WeBWorK / Authen.pm Repository:
ViewVC logotype

View of /branches/wheeler/webwork2/lib/WeBWorK/Authen.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 7144 - (download) (as text) (annotate)
Thu Jun 7 00:51:30 2012 UTC (7 years, 3 months ago) by wheeler
File size: 27946 byte(s)
Revisions to accommodate varying inputs from different LMSs and to improve interaction with Login.pm and Logout.pm

    1 ################################################################################
    2 # WeBWorK Online Homework Delivery System
    3 # Copyright  2000-2007 The WeBWorK Project, http://openwebwork.sf.net/
    4 # $CVSHeader: webwork2/lib/WeBWorK/Authen.pm,v 1.63 2012/06/06 22:03:15 wheeler Exp $
    5 #
    6 # This program is free software; you can redistribute it and/or modify it under
    7 # the terms of either: (a) the GNU General Public License as published by the
    8 # Free Software Foundation; either version 2, or (at your option) any later
    9 # version, or (b) the "Artistic License" which comes with this package.
   10 #
   11 # This program is distributed in the hope that it will be useful, but WITHOUT
   12 # ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
   13 # FOR A PARTICULAR PURPOSE.  See either the GNU General Public License or the
   14 # Artistic License for more details.
   15 ################################################################################
   16 
   17 package WeBWorK::Authen;
   18 
   19 =head1 NAME
   20 
   21 WeBWorK::Authen - Check user identity, manage session keys.
   22 
   23 =head1 SYNOPSIS
   24 
   25  # get the name of the appropriate Authen class, based on the %authen hash in $ce
   26  my $class_name = WeBWorK::Authen::class($ce, "user_module");
   27 
   28  # load that class
   29  require $class_name;
   30 
   31  # create an authen object
   32  my $authen = $class_name->new($r);
   33 
   34  # verify credentials
   35  $authen->verify or die "Authentication failed";
   36 
   37  # verification status is stored for quick retrieval later
   38  my $auth_ok = $authen->was_verified;
   39 
   40  # for some reason, you might want to clear that cache
   41  $authen->forget_verification;
   42 
   43 =head1 DESCRIPTION
   44 
   45 WeBWorK::Authen is the base class for all WeBWorK authentication classes. It
   46 provides default authentication behavior which can be selectively overridden in
   47 subclasses.
   48 
   49 =cut
   50 
   51 use strict;
   52 use warnings;
   53 use WeBWorK::Cookie;
   54 use Date::Format;
   55 use Socket qw/unpack_sockaddr_in inet_ntoa/; # for logging
   56 use WeBWorK::Debug;
   57 use WeBWorK::Utils qw/writeCourseLog runtime_use/;
   58 use WeBWorK::Localize;
   59 use URI::Escape;
   60 use Carp;
   61 
   62 use mod_perl;
   63 use constant MP2 => ( exists $ENV{MOD_PERL_API_VERSION} and $ENV{MOD_PERL_API_VERSION} >= 2 );
   64 
   65 
   66 #####################
   67 ## WeBWorK-tr modification
   68 ## If GENERIC_ERROR_MESSAGE is constant, we can't translate it
   69 
   70 #use vars qw($GENERIC_ERROR_MESSAGE);
   71 our $GENERIC_ERROR_MESSAGE = "";  # define in new
   72 
   73 ## WeBWorK-tr end modification
   74 #####################
   75 
   76 use constant COOKIE_LIFESPAN => 60*60*24*30; # 30 days
   77 #use constant GENERIC_ERROR_MESSAGE => "Invalid user ID or password.";
   78 
   79 
   80 BEGIN {
   81   if (MP2) {
   82     require APR::SockAddr;
   83     APR::SockAddr->import();
   84     require Apache2::Connection;
   85     Apache2::Connection->import();
   86     require APR::Request::Error;
   87     APR::Request::Error->import;
   88   }
   89 }
   90 
   91 ################################################################################
   92 # Public API
   93 ################################################################################
   94 
   95 =head1 FACTORY
   96 
   97 =over
   98 
   99 =item class($ce, $type)
  100 
  101 This subroutine consults the given WeBWorK::CourseEnvironment object to
  102 determine which WeBWorK::Authen subclass should be used. $type can be any key
  103 given in the %authen hash in the course environment. If the type is not found in
  104 the %authen hash, an exception is thrown.
  105 
  106 =cut
  107 
  108 sub class {
  109   my ($ce, $type) = @_;
  110 
  111   if (exists $ce->{authen}{$type}) {
  112     if (ref $ce->{authen}{$type} eq "ARRAY") {
  113       my $authen_type = shift @{$ce ->{authen}{$type}};
  114       #debug("ref of authen_type = |" . ref($authen_type) . "|");
  115       if (ref ($authen_type) eq "HASH") {
  116         if (exists $authen_type->{$ce->{dbLayoutName}}) {
  117           return $authen_type->{$ce->{dbLayoutName}};
  118         } elsif (exists $authen_type->{"*"}) {
  119           return $authen_type->{"*"};
  120         } else {
  121           die "authentication type '$type' in the course environment has no entry for db layout '", $ce->{dbLayoutName}, "' and no default entry (*)";
  122         }
  123       } else {
  124           return $authen_type;
  125       }
  126     } elsif (ref $ce->{authen}{$type} eq "HASH") {
  127       if (exists $ce->{authen}{$type}{$ce->{dbLayoutName}}) {
  128         return $ce->{authen}{$type}{$ce->{dbLayoutName}};
  129       } elsif (exists $ce->{authen}{$type}{"*"}) {
  130         return $ce->{authen}{$type}{"*"};
  131       } else {
  132         die "authentication type '$type' in the course environment has no entry for db layout '", $ce->{dbLayoutName}, "' and no default entry (*)";
  133       }
  134     } else {
  135       return $ce->{authen}{$type};
  136     }
  137   } else {
  138     die "authentication type '$type' not found in course environment";
  139   }
  140 }
  141 
  142 sub call_next_authen_method {
  143   my $self = shift;
  144   my $r = $self -> {r};
  145   my $ce = $r -> {ce};
  146 
  147   my $user_authen_module = WeBWorK::Authen::class($ce, "user_module");
  148   #debug("user_authen_module = |$user_authen_module|");
  149   if (!defined($user_authen_module or $user_authen_module eq "")) {
  150     $self->{error} = $r->maketext("No authentication method found for your request.  "
  151       . "If this recurs, please speak with your instructor.");
  152     $self->{log_error} .= "None of the specified authentication modules could handle the request.";
  153     return(0);
  154   } else {
  155     runtime_use $user_authen_module;
  156     my $authen = $user_authen_module->new($r);
  157     #debug("Using user_authen_module $user_authen_module: $authen\n");
  158     $r->authen($authen);
  159 
  160     return $authen -> verify;
  161   }
  162 }
  163 
  164 
  165 =back
  166 
  167 =cut
  168 
  169 =head1 CONSTRUCTOR
  170 
  171 =over
  172 
  173 =item new($r)
  174 
  175 Instantiates a new WeBWorK::Authen object for the given WeBWorK::Requst ($r).
  176 
  177 =cut
  178 
  179 sub new {
  180   my ($invocant, $r) = @_;
  181   my $class = ref($invocant) || $invocant;
  182   my $self = {
  183     r => $r,
  184   };
  185   #initialize
  186   $GENERIC_ERROR_MESSAGE = $r->maketext("Invalid user ID or password.");
  187   bless $self, $class;
  188   return $self;
  189 }
  190 
  191 =back
  192 
  193 =cut
  194 
  195 =head1 METHODS
  196 
  197 =over
  198 
  199 =cut
  200 
  201 sub  request_has_data_for_this_verification_module {
  202   #debug("Authen::request_has_data_for_this_verification_module will return a 1");
  203   return(1);
  204 }
  205 
  206 sub verify {
  207   debug("BEGIN VERIFY");
  208   my $self = shift;
  209   my $r = $self->{r};
  210 
  211   if (! ($self-> request_has_data_for_this_verification_module)) {
  212     return ( $self -> call_next_authen_method());
  213   }
  214 
  215   my $result = $self->do_verify;
  216   my $error = $self->{error};
  217   my $log_error = $self->{log_error};
  218 
  219   $self->{was_verified} = $result ? 1 : 0;
  220 
  221   if ($self->can("site_fixup")) {
  222     $self->site_fixup;
  223   }
  224 
  225   if ($result) {
  226     $self->write_log_entry("LOGIN OK") if $self->{initial_login};
  227     $self->maybe_send_cookie;
  228     $self->set_params;
  229   } else {
  230     if (defined $log_error) {
  231       $self->write_log_entry("LOGIN FAILED $log_error");
  232     }
  233     if (!defined($error) or !$error) {
  234       $error = $r->maketext("Your authentication failed.  Please try again."
  235         . "  Please speak with your instructor if you need help.")
  236     }
  237     $self->maybe_kill_cookie;
  238     if ($error) {
  239       MP2 ? $r->notes->set(authen_error => $error) : $r->notes("authen_error" => $error);
  240     }
  241   }
  242 
  243   debug("END VERIFY");
  244   return $result;
  245 }
  246 
  247 =item was_verified()
  248 
  249 Returns true if verify() returned true the last time it was called.
  250 
  251 =cut
  252 
  253 sub was_verified {
  254   my ($self) = @_;
  255 
  256   return 1 if exists $self->{was_verified} and $self->{was_verified};
  257   return 0;
  258 }
  259 
  260 =item forget_verification()
  261 
  262 Future calls to was_verified() will return false, until verify() is called again and succeeds.
  263 
  264 =cut
  265 
  266 sub forget_verification {
  267   my ($self) = @_;
  268   my $r = $self -> {r};
  269   my $ce = $r -> {ce};
  270 
  271   $self->{was_verified} = 0;
  272 
  273 }
  274 
  275 =back
  276 
  277 =cut
  278 
  279 ################################################################################
  280 # Helper functions (called by verify)
  281 ################################################################################
  282 
  283 sub do_verify {
  284   my $self = shift;
  285   my $r = $self->{r};
  286   my $ce = $r->ce;
  287   my $db = $r->db;
  288 
  289   return 0 unless $db;
  290 
  291   return 0 unless $self->get_credentials;
  292 
  293   return 0 unless $self->check_user;
  294 
  295   my $practiceUserPrefix = $ce->{practiceUserPrefix};
  296   if (defined($self->{login_type}) && $self->{login_type} eq "guest"){
  297     return $self->verify_practice_user;
  298   } else {
  299     return $self->verify_normal_user;
  300   }
  301 }
  302 
  303 sub get_credentials {
  304   my ($self) = @_;
  305   my $r = $self->{r};
  306   my $ce = $r->ce;
  307   my $db = $r->db;
  308 
  309   # allow guest login: if the "Guest Login" button was clicked, we find an unused
  310   # practice user and create a session for it.
  311   if ($r->param("login_practice_user")) {
  312     my $practiceUserPrefix = $ce->{practiceUserPrefix};
  313     # DBFIX search should happen in database
  314     my @guestUserIDs = grep m/^$practiceUserPrefix/, $db->listUsers;
  315     my @GuestUsers = $db->getUsers(@guestUserIDs);
  316     my @allowedGuestUsers = grep { $ce->status_abbrev_has_behavior($_->status, "allow_course_access") } @GuestUsers;
  317     my @allowedGestUserIDs = map { $_->user_id } @allowedGuestUsers;
  318 
  319     foreach my $userID (@allowedGestUserIDs) {
  320       if (not $self->unexpired_session_exists($userID)) {
  321         my $newKey = $self->create_session($userID);
  322         $self->{initial_login} = 1;
  323 
  324         $self->{user_id} = $userID;
  325         $self->{session_key} = $newKey;
  326         $self->{login_type} = "guest";
  327         $self->{credential_source} = "none";
  328         debug("guest user '", $userID. "' key '", $newKey. "'");
  329         return 1;
  330       }
  331     }
  332 
  333     $self->{log_error} = "no guest logins are available";
  334     $self->{error} = "No guest logins are available. Please try again in a few minutes.";
  335     return 0;
  336   }
  337 
  338   my ($cookieUser, $cookieKey, $cookieTimeStamp) = $self->fetchCookie;
  339 
  340   if (defined $cookieUser and defined $r->param("user") ) {
  341     if ($cookieUser ne $r->param("user")) {
  342       croak ("cookieUser = $cookieUser and paramUser = ". $r->param("user") . " are different.");
  343     }
  344     if (defined $cookieKey and defined $r->param("key")) {
  345       $self -> {user_id} = $cookieUser;
  346       $self -> {password} = $r->param("passwd");
  347       $self -> {login_type} = "normal";
  348       $self -> {credential_source} = "params_and_cookie";
  349       $self -> {session_key} = $cookieKey;
  350       $self -> {cookie_timestamp} = $cookieTimeStamp;
  351       if ($cookieKey ne $r->param("key")) {
  352         warn ("cookieKey = $cookieKey and param key = " . $r -> param("key") . " are different, perhaps"
  353            ." because you opened several windows for the same site and then backed up from a newer one to an older one."
  354            ."  Avoid doing so.");
  355       $self -> {credential_source} = "conflicting_params_and_cookie";
  356       }
  357       debug("params and cookie user '", $self->{user_id}, "' credential_source = '", $self->{credential_source},
  358         "' params and cookie session key = '", $self->{session_key}, "' cookie_timestamp '", $self->{cookieTimeStamp}, "'");
  359       return 1;
  360     } elsif (defined $r -> param("key")) {
  361       $self->{user_id} = $r->param("user");
  362       $self->{session_key} = $r->param("key");
  363       $self->{password} = $r->param("passwd");
  364       $self->{login_type} = "normal";
  365       $self->{credential_source} = "params";
  366       debug("params user '", $self->{user_id}, "' password '", $self->{password}, "' key '", $self->{session_key}, "'");
  367       return 1;
  368     } elsif (defined $cookieKey) {
  369       $self->{user_id} = $cookieUser;
  370       $self->{session_key} = $cookieKey;
  371       $self->{cookie_timestamp} = $cookieTimeStamp;
  372       $self->{login_type} = "normal";
  373       $self->{credential_source} = "cookie";
  374       debug("cookie user '", $self->{user_id}, "' key '", $self->{session_key}, "' cookie_timestamp '", $self->{cookieTimeStamp}, "'");
  375       return 1;
  376     } else {
  377       $self -> {user_id} = $cookieUser;
  378       $self -> {session_key} = $cookieKey; # will be undefined
  379       $self -> {password} = $r->param("passwd");
  380       $self -> {cookie_timestamp} = $cookieTimeStamp;
  381       $self -> {login_type} = "normal";
  382       $self -> {credential_source} = "params_and_cookie";
  383       debug("params and cookie user '", $self->{user_id}, "' params and cookie session key = '",
  384          $self->{session_key}, "' cookie_timestamp '", $self->{cookieTimeStamp}, "'");
  385       return 1;
  386     }
  387   }
  388   # at least the user ID is available in request parameters
  389   if (defined $r->param("user")) {
  390     $self->{user_id} = $r->param("user");
  391     $self->{session_key} = $r->param("key");
  392     $self->{password} = $r->param("passwd");
  393     $self->{login_type} = "normal";
  394     $self->{credential_source} = "params";
  395     debug("params user '", $self->{user_id}, "' password '", $self->{password}, "' key '", $self->{session_key}, "'");
  396     return 1;
  397   }
  398 
  399   if (defined $cookieUser) {
  400     $self->{user_id} = $cookieUser;
  401     $self->{session_key} = $cookieKey;
  402     $self->{cookie_timestamp} = $cookieTimeStamp;
  403     $self->{login_type} = "normal";
  404     $self->{credential_source} = "cookie";
  405     debug("cookie user '", $self->{user_id}, "' key '", $self->{session_key}, "' cookie_timestamp '", $self->{cookieTimeStamp}, "'");
  406     return 1;
  407   }
  408 }
  409 
  410 sub check_user {
  411   my $self = shift;
  412   my $r = $self->{r};
  413   my $ce = $r->ce;
  414   my $db = $r->db;
  415   my $authz = $r->authz;
  416 
  417   my $user_id = $self->{user_id};
  418 
  419   if (defined $user_id and $user_id eq "") {
  420     $self->{log_error} = "no user id specified";
  421     $self->{error} .= $r->maketext("You must specify a user ID.");
  422     return 0;
  423   }
  424 
  425   my $User = $db->getUser($user_id);
  426 
  427   unless ($User) {
  428     $self->{log_error} = "user unknown";
  429     $self->{error} = $GENERIC_ERROR_MESSAGE;
  430     return 0;
  431   }
  432 
  433   # FIXME "fix invalid status values" used to be here, but it needs to move to $db->getUser
  434 
  435   unless ($ce->status_abbrev_has_behavior($User->status, "allow_course_access")) {
  436     $self->{log_error} = "user not allowed course access";
  437     $self->{error} = $GENERIC_ERROR_MESSAGE;
  438     return 0;
  439   }
  440 
  441   unless ($authz->hasPermissions($user_id, "login")) {
  442     $self->{log_error} = "user not permitted to login";
  443     $self->{error} = $GENERIC_ERROR_MESSAGE;
  444     return 0;
  445   }
  446 
  447   return 1;
  448 }
  449 
  450 sub verify_practice_user {
  451   my $self = shift;
  452   my $r = $self->{r};
  453   my $ce = $r->ce;
  454 
  455   my $user_id = $self->{user_id};
  456   my $session_key = $self->{session_key};
  457 
  458   my ($sessionExists, $keyMatches, $timestampValid) = $self->check_session($user_id, $session_key, 1);
  459   debug("sessionExists='", $sessionExists, "' keyMatches='", $keyMatches, "' timestampValid='", $timestampValid, "'");
  460 
  461   if ($sessionExists) {
  462     if ($keyMatches) {
  463       if ($timestampValid) {
  464         return 1;
  465       } else {
  466         $self->{session_key} = $self->create_session($user_id);
  467         $self->{initial_login} = 1;
  468         return 1;
  469       }
  470     } else {
  471       if ($timestampValid) {
  472         my $debugPracticeUser = $ce->{debugPracticeUser};
  473         if (defined $debugPracticeUser and $user_id eq $debugPracticeUser) {
  474           $self->{session_key} = $self->create_session($user_id);
  475           $self->{initial_login} = 1;
  476           return 1;
  477         } else {
  478           $self->{log_error} = "guest account in use";
  479           $self->{error} = "That guest account is in use.";
  480           return 0;
  481         }
  482       } else {
  483         $self->{session_key} = $self->create_session($user_id);
  484         $self->{initial_login} = 1;
  485         return 1;
  486       }
  487     }
  488   } else {
  489     $self->{session_key} = $self->create_session($user_id);
  490     $self->{initial_login} = 1;
  491     return 1;
  492   }
  493 }
  494 
  495 sub verify_normal_user {
  496   my $self = shift;
  497   my $r = $self->{r};
  498 
  499   my $user_id = $self->{user_id};
  500   my $session_key = $self->{session_key};
  501 
  502   my ($sessionExists, $keyMatches, $timestampValid) = $self->check_session($user_id, $session_key, 1);
  503   debug("sessionExists='", $sessionExists, "' keyMatches='", $keyMatches, "' timestampValid='", $timestampValid, "'");
  504 
  505   if ($sessionExists and $keyMatches and $timestampValid) {
  506     return 1;
  507   } else {
  508     my $auth_result = $self->authenticate;
  509 
  510     if ($auth_result > 0) {
  511       $self->{session_key} = $self->create_session($user_id);
  512       $self->{initial_login} = 1;
  513       return 1;
  514     } elsif ($auth_result == 0) {
  515       $self->{log_error} = "authentication failed";
  516       $self->{error} = $GENERIC_ERROR_MESSAGE;
  517       return 0;
  518     } else { # ($auth_result < 0) => required data was not present
  519       if ($keyMatches and not $timestampValid) {
  520         $self->{error} .= $r->maketext("Your session has timed out due to inactivity. Please log in again.");
  521       }
  522       return 0;
  523     }
  524   }
  525 }
  526 
  527 #  1 == authentication succeeded
  528 #  0 == required data was present, but authentication failed
  529 # -1 == required data was not present (i.e. password missing)
  530 sub authenticate {
  531   my $self = shift;
  532   my $r = $self->{r};
  533 
  534   my $user_id = $self->{user_id};
  535   my $password = $self->{password};
  536 
  537   if (defined $password) {
  538     return $self->checkPassword($user_id, $password);
  539   } else {
  540     return -1;
  541   }
  542 }
  543 
  544 sub maybe_send_cookie {
  545   my $self = shift;
  546   my $r = $self->{r};
  547   my $ce = $r -> {ce};
  548 
  549   my ($cookie_user, $cookie_key, $cookie_timestamp) = $self->fetchCookie;
  550 
  551   # we send a cookie if any of these conditions are met:
  552 
  553   # (a) a cookie was used for authentication
  554   my $used_cookie = ($self->{credential_source} eq "cookie");
  555 
  556   # (b) a cookie was sent but not used for authentication, and the
  557   #     credentials used for authentication were the same as those in
  558   #     the cookie
  559   my $unused_valid_cookie = ($self->{credential_source} ne "cookie"
  560     and defined $cookie_user and $self->{user_id} eq $cookie_user
  561     and defined $cookie_key and $self->{session_key} eq $cookie_key);
  562 
  563   # (c) the user asked to have a cookie sent and is not a guest user.
  564   my $user_requests_cookie = ($self->{login_type} ne "guest"
  565     and $r->param("send_cookie"));
  566 
  567   # (d) session management is done via cookies.
  568   my $session_management_via_cookies =
  569     $ce -> {session_management_via} eq "session_cookie";
  570 
  571   debug("used_cookie='", $used_cookie, "' unused_valid_cookie='", $unused_valid_cookie, "' user_requests_cookie='", $user_requests_cookie,
  572       "' session_management_via_cookies ='", $session_management_via_cookies, "'");
  573 
  574   if ($used_cookie or $unused_valid_cookie or $user_requests_cookie or $session_management_via_cookies) {
  575     #debug("Authen::maybe_send_cookie is sending a cookie");
  576     $self->sendCookie($self->{user_id}, $self->{session_key});
  577   } else {
  578     $self->killCookie;
  579   }
  580 }
  581 
  582 sub maybe_kill_cookie {
  583   my $self = shift;
  584   $self->killCookie(@_);
  585 }
  586 
  587 sub set_params {
  588   my $self = shift;
  589   my $r = $self->{r};
  590 
  591   # A2 - params are not non-modifiable, with no explanation or workaround given in docs. WTF!
  592   $r->param("user", $self->{user_id});
  593   $r->param("key", $self->{session_key});
  594   $r->param("passwd", "");
  595 
  596   debug("params user='", $r->param("user"), "' key='", $r->param("key"), "' passwd='", $r->param("passwd"), "'");
  597 }
  598 
  599 ################################################################################
  600 # Password management
  601 ################################################################################
  602 
  603 sub checkPassword {
  604   my ($self, $userID, $possibleClearPassword) = @_;
  605   my $db = $self->{r}->db;
  606 
  607   my $Password = $db->getPassword($userID); # checked
  608   if (defined $Password) {
  609     # check against WW password database
  610     my $possibleCryptPassword = crypt $possibleClearPassword, $Password->password;
  611     if ($possibleCryptPassword eq $Password->password) {
  612       $self->write_log_entry("AUTH WWDB: password accepted");
  613       return 1;
  614     } else {
  615       if ($self->can("site_checkPassword")) {
  616         $self->write_log_entry("AUTH WWDB: password rejected, deferring to site_checkPassword");
  617         return $self->site_checkPassword($userID, $possibleClearPassword);
  618       } else {
  619         $self->write_log_entry("AUTH WWDB: password rejected");
  620         return 0;
  621       }
  622     }
  623   } else {
  624     $self->write_log_entry("AUTH WWDB: user has no password record");
  625     return 0;
  626   }
  627 }
  628 
  629 # Site-specific password checking
  630 #
  631 # The site_checkPassword routine can be used to provide a hook to your institution's
  632 # authentication system. If authentication against the  course's password database, the
  633 # method $self->site_checkPassword($userID, $clearTextPassword) is called. If this
  634 # method returns a true value, authentication succeeds.
  635 #
  636 # Here is an example site_checkPassword which checks the password against the Ohio State
  637 # popmail server:
  638 #   sub site_checkPassword {
  639 #     my ($self, $userID, $clearTextPassword) = @_;
  640 #     use Net::POP3;
  641 #     my $pop = Net::POP3->new('pop.service.ohio-state.edu', Timeout => 60);
  642 #     if ($pop->login($userID, $clearTextPassword)) {
  643 #       return 1;
  644 #     }
  645 #     return 0;
  646 #   }
  647 #
  648 # Since you have access to the WeBWorK::Authen object, the possibilities are limitless!
  649 # This example checks the password against the system password database and updates the
  650 # user's password in the course database if it succeeds:
  651 #   sub site_checkPassword {
  652 #     my ($self, $userID, $clearTextPassword) = @_;
  653 #     my $realCryptPassword = (getpwnam $userID)[1] or return 0;
  654 #     my $possibleCryptPassword = crypt($possibleClearPassword, $realCryptPassword); # user real PW as salt
  655 #     if ($possibleCryptPassword eq $realCryptPassword) {
  656 #       # update WeBWorK password
  657 #       use WeBWorK::Utils qw(cryptPassword);
  658 #       my $db = $self->{r}->db;
  659 #       my $Password = $db->getPassword($userID);
  660 #       my $pass = cryptPassword($clearTextPassword);
  661 #       $Password->password($pass);
  662 #       $db->putPassword($Password);
  663 #       return 1;
  664 #     } else {
  665 #       return 0;
  666 #     }
  667 #   }
  668 
  669 ################################################################################
  670 # Session key management
  671 ################################################################################
  672 
  673 sub unexpired_session_exists {
  674   my ($self, $userID) = @_;
  675   my $ce = $self->{r}->ce;
  676   my $db = $self->{r}->db;
  677 
  678   my $Key = $db->getKey($userID); # checked
  679   return 0 unless defined $Key;
  680   if (time <= $Key->timestamp()+$ce->{sessionKeyTimeout}) {
  681     # unexpired, but leave timestamp alone
  682     return 1;
  683   } else {
  684     # expired -- delete key
  685     # NEW: no longer delete the key here -- a user re-visiting with a formerly-valid key should
  686     # always get a "session expired" message. formerly, if they i.e. reload the login screen
  687     # the message disappears, which is confusing (i claim ;)
  688     #$db->deleteKey($userID);
  689     return 0;
  690   }
  691 }
  692 
  693 # clobbers any existing session for this $userID
  694 # if $newKey is not specified, a random key is generated
  695 # the key is returned
  696 sub create_session {
  697   my ($self, $userID, $newKey) = @_;
  698   my $ce = $self->{r}->ce;
  699   my $db = $self->{r}->db;
  700 
  701   my $timestamp = time;
  702   unless ($newKey) {
  703     my @chars = @{ $ce->{sessionKeyChars} };
  704     my $length = $ce->{sessionKeyLength};
  705 
  706     srand;
  707     $newKey = join ("", @chars[map rand(@chars), 1 .. $length]);
  708   }
  709 
  710   my $Key = $db->newKey(user_id=>$userID, key=>$newKey, timestamp=>$timestamp);
  711   # DBFIXME this should be a REPLACE
  712   eval { $db->deleteKey($userID) };
  713   $db->addKey($Key);
  714 
  715   #if ($ce -> {session_management_via} eq "session_cookie"),
  716   #    then the subroutine maybe_send_cookie should send a cookie.
  717 
  718   return $newKey;
  719 }
  720 
  721 # returns ($sessionExists, $keyMatches, $timestampValid)
  722 # if $updateTimestamp is true, the timestamp on a valid session is updated
  723 sub check_session {
  724   my ($self, $userID, $possibleKey, $updateTimestamp) = @_;
  725   my $ce = $self->{r}->ce;
  726   my $db = $self->{r}->db;
  727 
  728   my $Key = $db->getKey($userID); # checked
  729   return 0 unless defined $Key;
  730   my $keyMatches = (defined $possibleKey and $possibleKey eq $Key->key);
  731 
  732   my $timestampValid=0;
  733   if ($ce -> {session_management_via} eq "session_cookie" and defined($self->{cookie_timestamp})) {
  734     $timestampValid = (time <= $self -> {cookie_timestamp} + $ce->{sessionKeyTimeout});
  735   } else {
  736     $timestampValid = (time <= $Key->timestamp()+$ce->{sessionKeyTimeout});
  737     if ($keyMatches and $timestampValid and $updateTimestamp) {
  738       $Key->timestamp(time);
  739       $db->putKey($Key);
  740     }
  741   }
  742   return (1, $keyMatches, $timestampValid);
  743 }
  744 
  745 sub killSession {
  746   my $self = shift;
  747 
  748   my $r = $self -> {r};
  749   my $ce = $r -> {ce};
  750   my $db = $r -> {db};
  751 
  752   $self -> forget_verification;
  753   if ($ce -> {session_management_via} eq "session_cookie")  {
  754     $self -> killCookie();
  755   }
  756 
  757   my $userID = $r -> {user_id};
  758   if (defined($userID)) {
  759      $db -> deleteKey($userID);
  760   }
  761 }
  762 
  763 
  764 ################################################################################
  765 # Cookie management
  766 ################################################################################
  767 
  768 sub fetchCookie {
  769   my $self = shift;
  770   my $r = $self->{r};
  771   my $ce = $r->ce;
  772   my $urlpath = $r->urlpath;
  773 
  774   my $courseID = $urlpath->arg("courseID");
  775 
  776   # AP2 - Apache2::Cookie needs $r, Apache::Cookie doesn't
  777     #my %cookies = WeBWorK::Cookie->fetch( MP2 ? $r : () );
  778     #my $cookie = $cookies{"WeBWorKCourseAuthen.$courseID"};
  779 
  780   my $cookie = undef;
  781   if (MP2) {
  782 
  783     my $jar = undef;
  784     eval {
  785             $jar = $r->jar; #table of cookies
  786       };
  787       if (ref $@ and $@->isa("APR::Request::Error") ) {
  788       debug("Error parsing cookies, will use a partial result");
  789           $jar = $@->jar; # table of successfully parsed cookies
  790       };
  791     if ($jar) {
  792       $cookie = uri_unescape($jar->get("WeBWorKCourseAuthen.$courseID"));
  793     };
  794   } else {
  795     my %cookies = WeBWorK::Cookie->fetch();
  796     $cookie = $cookies{"WeBWorKCourseAuthen.$courseID"};
  797     if ($cookie) {
  798       debug("found a cookie for this course: '", $cookie->as_string, "'");
  799       $cookie = $cookie->value;
  800     }
  801   }
  802 
  803   if ($cookie) {
  804         #debug("found a cookie for this course: '", $cookie->as_string, "'");
  805         #debug("cookie has this value: '", $cookie->value, "'");
  806         #my ($userID, $key) = split "\t", $cookie->value;
  807         debug("cookie has this value: '", $cookie, "'");
  808         my ($userID, $key, $timestamp) = split "\t", $cookie;
  809     if (defined $userID and defined $key and $userID ne "" and $key ne "") {
  810       debug("looks good, returning userID='$userID' key='$key'");
  811       return $userID, $key, $timestamp;
  812     } else {
  813       debug("malformed cookie. returning nothing.");
  814       return;
  815     }
  816   } else {
  817     debug("found no cookie for this course. returning nothing.");
  818     return;
  819   }
  820 }
  821 
  822 sub sendCookie {
  823   my ($self, $userID, $key) = @_;
  824   my $r = $self->{r};
  825   my $ce = $r->ce;
  826 
  827   my $courseID = $r->urlpath->arg("courseID");
  828 
  829   my $timestamp = time();
  830 
  831   my $cookie = WeBWorK::Cookie->new($r,
  832     -name    => "WeBWorKCourseAuthen.$courseID",
  833     -value   => "$userID\t$key\t$timestamp",
  834     -path    => $ce->{webworkURLRoot},
  835     -secure  => 0,
  836   );
  837 
  838   if ($ce->{session_management_via} ne "session_cookie") {
  839     my $expires = time2str("%a, %d-%h-%Y %H:%M:%S %Z", time+COOKIE_LIFESPAN, "GMT");
  840     $cookie -> expires($expires);
  841   }
  842   if ($r->hostname ne "localhost" && $r->hostname ne "127.0.0.1") {
  843     $cookie -> domain($r->hostname);    # if $r->hostname = "localhost" or "127.0.0.1", then this must be omitted.
  844   }
  845 
  846   #debug("about to add Set-Cookie header with this string: '", $cookie->as_string, "'");
  847   eval {$r->headers_out->set("Set-Cookie" => $cookie->as_string);};
  848   if ($@) {croak $@; }
  849 }
  850 
  851 sub killCookie {
  852   my ($self) = @_;
  853   my $r = $self->{r};
  854   my $ce = $r->ce;
  855 
  856   my $courseID = $r->urlpath->arg("courseID");
  857 
  858   my $expires = time2str("%a, %d-%h-%Y %H:%M:%S %Z", time-60*60*24, "GMT");
  859   my $cookie = WeBWorK::Cookie->new($r,
  860     -name => "WeBWorKCourseAuthen.$courseID",
  861     -value => "\t",
  862     -expires => $expires,
  863     -path => $ce->{webworkURLRoot},
  864     -secure => 0,
  865   );
  866   if ($r->hostname ne "localhost" && $r->hostname ne "127.0.0.1") {
  867     $cookie -> domain($r->hostname);  # if $r->hostname = "localhost" or "127.0.0.1", then this must be omitted.
  868   }
  869 
  870   #debug( "killCookie is about to set an expired cookie");
  871   #debug("about to add Set-Cookie header with this string: '", $cookie->as_string, "'");
  872   eval {$r->headers_out->set("Set-Cookie" => $cookie->as_string);};
  873   if ($@) {croak $@; }
  874 }
  875 
  876 ################################################################################
  877 # Utilities
  878 ################################################################################
  879 
  880 sub write_log_entry {
  881   my ($self, $message) = @_;
  882   my $r = $self->{r};
  883   my $ce = $r->ce;
  884 
  885   my $user_id = defined $self->{user_id} ? $self->{user_id} : "";
  886   my $login_type = defined $self->{login_type} ? $self->{login_type} : "";
  887   my $credential_source = defined $self->{credential_source} ? $self->{credential_source} : "";
  888 
  889   my ($remote_host, $remote_port);
  890   if (MP2) {
  891     $remote_host = $r->connection->remote_addr->ip_get || "UNKNOWN";
  892     $remote_port = $r->connection->remote_addr->port || "UNKNOWN";
  893   } else {
  894     ($remote_port, $remote_host) = unpack_sockaddr_in($r->connection->remote_addr);
  895     $remote_host = defined $remote_host ? inet_ntoa($remote_host) : "UNKNOWN";
  896     $remote_port = "UNKNOWN" unless defined $remote_port;
  897   }
  898   my $user_agent = $r->headers_in->{"User-Agent"};
  899 
  900   my $log_msg = "$message user_id=$user_id login_type=$login_type credential_source=$credential_source host=$remote_host port=$remote_port UA=$user_agent";
  901   debug("Writing to login log: '$log_msg'.\n");
  902   writeCourseLog($ce, "login_log", $log_msg);
  903 }
  904 
  905 1;
  906 

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9