[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 7146 - (download) (as text) (annotate)
Sun Jun 17 17:01:38 2012 UTC (7 years, 5 months ago) by wheeler
File size: 28043 byte(s)
Fixed an inappropriate displaying of the default authentication error message.

    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       if (defined($r->param("user")) or defined($r->param("user_id"))) {
  235         $error = $r->maketext("Your authentication failed.  Please try again."
  236           . "  Please speak with your instructor if you need help.")
  237       }
  238     }
  239     $self->maybe_kill_cookie;
  240     if (defined($error) and $error) {
  241       MP2 ? $r->notes->set(authen_error => $error) : $r->notes("authen_error" => $error);
  242     }
  243   }
  244 
  245   debug("END VERIFY");
  246   return $result;
  247 }
  248 
  249 =item was_verified()
  250 
  251 Returns true if verify() returned true the last time it was called.
  252 
  253 =cut
  254 
  255 sub was_verified {
  256   my ($self) = @_;
  257 
  258   return 1 if exists $self->{was_verified} and $self->{was_verified};
  259   return 0;
  260 }
  261 
  262 =item forget_verification()
  263 
  264 Future calls to was_verified() will return false, until verify() is called again and succeeds.
  265 
  266 =cut
  267 
  268 sub forget_verification {
  269   my ($self) = @_;
  270   my $r = $self -> {r};
  271   my $ce = $r -> {ce};
  272 
  273   $self->{was_verified} = 0;
  274 
  275 }
  276 
  277 =back
  278 
  279 =cut
  280 
  281 ################################################################################
  282 # Helper functions (called by verify)
  283 ################################################################################
  284 
  285 sub do_verify {
  286   my $self = shift;
  287   my $r = $self->{r};
  288   my $ce = $r->ce;
  289   my $db = $r->db;
  290 
  291   return 0 unless $db;
  292 
  293   return 0 unless $self->get_credentials;
  294 
  295   return 0 unless $self->check_user;
  296 
  297   my $practiceUserPrefix = $ce->{practiceUserPrefix};
  298   if (defined($self->{login_type}) && $self->{login_type} eq "guest"){
  299     return $self->verify_practice_user;
  300   } else {
  301     return $self->verify_normal_user;
  302   }
  303 }
  304 
  305 sub get_credentials {
  306   my ($self) = @_;
  307   my $r = $self->{r};
  308   my $ce = $r->ce;
  309   my $db = $r->db;
  310 
  311   # allow guest login: if the "Guest Login" button was clicked, we find an unused
  312   # practice user and create a session for it.
  313   if ($r->param("login_practice_user")) {
  314     my $practiceUserPrefix = $ce->{practiceUserPrefix};
  315     # DBFIX search should happen in database
  316     my @guestUserIDs = grep m/^$practiceUserPrefix/, $db->listUsers;
  317     my @GuestUsers = $db->getUsers(@guestUserIDs);
  318     my @allowedGuestUsers = grep { $ce->status_abbrev_has_behavior($_->status, "allow_course_access") } @GuestUsers;
  319     my @allowedGestUserIDs = map { $_->user_id } @allowedGuestUsers;
  320 
  321     foreach my $userID (@allowedGestUserIDs) {
  322       if (not $self->unexpired_session_exists($userID)) {
  323         my $newKey = $self->create_session($userID);
  324         $self->{initial_login} = 1;
  325 
  326         $self->{user_id} = $userID;
  327         $self->{session_key} = $newKey;
  328         $self->{login_type} = "guest";
  329         $self->{credential_source} = "none";
  330         debug("guest user '", $userID. "' key '", $newKey. "'");
  331         return 1;
  332       }
  333     }
  334 
  335     $self->{log_error} = "no guest logins are available";
  336     $self->{error} = "No guest logins are available. Please try again in a few minutes.";
  337     return 0;
  338   }
  339 
  340   my ($cookieUser, $cookieKey, $cookieTimeStamp) = $self->fetchCookie;
  341 
  342   if (defined $cookieUser and defined $r->param("user") ) {
  343     if ($cookieUser ne $r->param("user")) {
  344       croak ("cookieUser = $cookieUser and paramUser = ". $r->param("user") . " are different.");
  345     }
  346     if (defined $cookieKey and defined $r->param("key")) {
  347       $self -> {user_id} = $cookieUser;
  348       $self -> {password} = $r->param("passwd");
  349       $self -> {login_type} = "normal";
  350       $self -> {credential_source} = "params_and_cookie";
  351       $self -> {session_key} = $cookieKey;
  352       $self -> {cookie_timestamp} = $cookieTimeStamp;
  353       if ($cookieKey ne $r->param("key")) {
  354         warn ("cookieKey = $cookieKey and param key = " . $r -> param("key") . " are different, perhaps"
  355            ." because you opened several windows for the same site and then backed up from a newer one to an older one."
  356            ."  Avoid doing so.");
  357       $self -> {credential_source} = "conflicting_params_and_cookie";
  358       }
  359       debug("params and cookie user '", $self->{user_id}, "' credential_source = '", $self->{credential_source},
  360         "' params and cookie session key = '", $self->{session_key}, "' cookie_timestamp '", $self->{cookieTimeStamp}, "'");
  361       return 1;
  362     } elsif (defined $r -> param("key")) {
  363       $self->{user_id} = $r->param("user");
  364       $self->{session_key} = $r->param("key");
  365       $self->{password} = $r->param("passwd");
  366       $self->{login_type} = "normal";
  367       $self->{credential_source} = "params";
  368       debug("params user '", $self->{user_id}, "' password '", $self->{password}, "' key '", $self->{session_key}, "'");
  369       return 1;
  370     } elsif (defined $cookieKey) {
  371       $self->{user_id} = $cookieUser;
  372       $self->{session_key} = $cookieKey;
  373       $self->{cookie_timestamp} = $cookieTimeStamp;
  374       $self->{login_type} = "normal";
  375       $self->{credential_source} = "cookie";
  376       debug("cookie user '", $self->{user_id}, "' key '", $self->{session_key}, "' cookie_timestamp '", $self->{cookieTimeStamp}, "'");
  377       return 1;
  378     } else {
  379       $self -> {user_id} = $cookieUser;
  380       $self -> {session_key} = $cookieKey; # will be undefined
  381       $self -> {password} = $r->param("passwd");
  382       $self -> {cookie_timestamp} = $cookieTimeStamp;
  383       $self -> {login_type} = "normal";
  384       $self -> {credential_source} = "params_and_cookie";
  385       debug("params and cookie user '", $self->{user_id}, "' params and cookie session key = '",
  386          $self->{session_key}, "' cookie_timestamp '", $self->{cookieTimeStamp}, "'");
  387       return 1;
  388     }
  389   }
  390   # at least the user ID is available in request parameters
  391   if (defined $r->param("user")) {
  392     $self->{user_id} = $r->param("user");
  393     $self->{session_key} = $r->param("key");
  394     $self->{password} = $r->param("passwd");
  395     $self->{login_type} = "normal";
  396     $self->{credential_source} = "params";
  397     debug("params user '", $self->{user_id}, "' password '", $self->{password}, "' key '", $self->{session_key}, "'");
  398     return 1;
  399   }
  400 
  401   if (defined $cookieUser) {
  402     $self->{user_id} = $cookieUser;
  403     $self->{session_key} = $cookieKey;
  404     $self->{cookie_timestamp} = $cookieTimeStamp;
  405     $self->{login_type} = "normal";
  406     $self->{credential_source} = "cookie";
  407     debug("cookie user '", $self->{user_id}, "' key '", $self->{session_key}, "' cookie_timestamp '", $self->{cookieTimeStamp}, "'");
  408     return 1;
  409   }
  410 }
  411 
  412 sub check_user {
  413   my $self = shift;
  414   my $r = $self->{r};
  415   my $ce = $r->ce;
  416   my $db = $r->db;
  417   my $authz = $r->authz;
  418 
  419   my $user_id = $self->{user_id};
  420 
  421   if (defined $user_id and $user_id eq "") {
  422     $self->{log_error} = "no user id specified";
  423     $self->{error} .= $r->maketext("You must specify a user ID.");
  424     return 0;
  425   }
  426 
  427   my $User = $db->getUser($user_id);
  428 
  429   unless ($User) {
  430     $self->{log_error} = "user unknown";
  431     $self->{error} = $GENERIC_ERROR_MESSAGE;
  432     return 0;
  433   }
  434 
  435   # FIXME "fix invalid status values" used to be here, but it needs to move to $db->getUser
  436 
  437   unless ($ce->status_abbrev_has_behavior($User->status, "allow_course_access")) {
  438     $self->{log_error} = "user not allowed course access";
  439     $self->{error} = $GENERIC_ERROR_MESSAGE;
  440     return 0;
  441   }
  442 
  443   unless ($authz->hasPermissions($user_id, "login")) {
  444     $self->{log_error} = "user not permitted to login";
  445     $self->{error} = $GENERIC_ERROR_MESSAGE;
  446     return 0;
  447   }
  448 
  449   return 1;
  450 }
  451 
  452 sub verify_practice_user {
  453   my $self = shift;
  454   my $r = $self->{r};
  455   my $ce = $r->ce;
  456 
  457   my $user_id = $self->{user_id};
  458   my $session_key = $self->{session_key};
  459 
  460   my ($sessionExists, $keyMatches, $timestampValid) = $self->check_session($user_id, $session_key, 1);
  461   debug("sessionExists='", $sessionExists, "' keyMatches='", $keyMatches, "' timestampValid='", $timestampValid, "'");
  462 
  463   if ($sessionExists) {
  464     if ($keyMatches) {
  465       if ($timestampValid) {
  466         return 1;
  467       } else {
  468         $self->{session_key} = $self->create_session($user_id);
  469         $self->{initial_login} = 1;
  470         return 1;
  471       }
  472     } else {
  473       if ($timestampValid) {
  474         my $debugPracticeUser = $ce->{debugPracticeUser};
  475         if (defined $debugPracticeUser and $user_id eq $debugPracticeUser) {
  476           $self->{session_key} = $self->create_session($user_id);
  477           $self->{initial_login} = 1;
  478           return 1;
  479         } else {
  480           $self->{log_error} = "guest account in use";
  481           $self->{error} = "That guest account is in use.";
  482           return 0;
  483         }
  484       } else {
  485         $self->{session_key} = $self->create_session($user_id);
  486         $self->{initial_login} = 1;
  487         return 1;
  488       }
  489     }
  490   } else {
  491     $self->{session_key} = $self->create_session($user_id);
  492     $self->{initial_login} = 1;
  493     return 1;
  494   }
  495 }
  496 
  497 sub verify_normal_user {
  498   my $self = shift;
  499   my $r = $self->{r};
  500 
  501   my $user_id = $self->{user_id};
  502   my $session_key = $self->{session_key};
  503 
  504   my ($sessionExists, $keyMatches, $timestampValid) = $self->check_session($user_id, $session_key, 1);
  505   debug("sessionExists='", $sessionExists, "' keyMatches='", $keyMatches, "' timestampValid='", $timestampValid, "'");
  506 
  507   if ($sessionExists and $keyMatches and $timestampValid) {
  508     return 1;
  509   } else {
  510     my $auth_result = $self->authenticate;
  511 
  512     if ($auth_result > 0) {
  513       $self->{session_key} = $self->create_session($user_id);
  514       $self->{initial_login} = 1;
  515       return 1;
  516     } elsif ($auth_result == 0) {
  517       $self->{log_error} = "authentication failed";
  518       $self->{error} = $GENERIC_ERROR_MESSAGE;
  519       return 0;
  520     } else { # ($auth_result < 0) => required data was not present
  521       if ($keyMatches and not $timestampValid) {
  522         $self->{error} .= $r->maketext("Your session has timed out due to inactivity. Please log in again.");
  523       }
  524       return 0;
  525     }
  526   }
  527 }
  528 
  529 #  1 == authentication succeeded
  530 #  0 == required data was present, but authentication failed
  531 # -1 == required data was not present (i.e. password missing)
  532 sub authenticate {
  533   my $self = shift;
  534   my $r = $self->{r};
  535 
  536   my $user_id = $self->{user_id};
  537   my $password = $self->{password};
  538 
  539   if (defined $password) {
  540     return $self->checkPassword($user_id, $password);
  541   } else {
  542     return -1;
  543   }
  544 }
  545 
  546 sub maybe_send_cookie {
  547   my $self = shift;
  548   my $r = $self->{r};
  549   my $ce = $r -> {ce};
  550 
  551   my ($cookie_user, $cookie_key, $cookie_timestamp) = $self->fetchCookie;
  552 
  553   # we send a cookie if any of these conditions are met:
  554 
  555   # (a) a cookie was used for authentication
  556   my $used_cookie = ($self->{credential_source} eq "cookie");
  557 
  558   # (b) a cookie was sent but not used for authentication, and the
  559   #     credentials used for authentication were the same as those in
  560   #     the cookie
  561   my $unused_valid_cookie = ($self->{credential_source} ne "cookie"
  562     and defined $cookie_user and $self->{user_id} eq $cookie_user
  563     and defined $cookie_key and $self->{session_key} eq $cookie_key);
  564 
  565   # (c) the user asked to have a cookie sent and is not a guest user.
  566   my $user_requests_cookie = ($self->{login_type} ne "guest"
  567     and $r->param("send_cookie"));
  568 
  569   # (d) session management is done via cookies.
  570   my $session_management_via_cookies =
  571     $ce -> {session_management_via} eq "session_cookie";
  572 
  573   debug("used_cookie='", $used_cookie, "' unused_valid_cookie='", $unused_valid_cookie, "' user_requests_cookie='", $user_requests_cookie,
  574       "' session_management_via_cookies ='", $session_management_via_cookies, "'");
  575 
  576   if ($used_cookie or $unused_valid_cookie or $user_requests_cookie or $session_management_via_cookies) {
  577     #debug("Authen::maybe_send_cookie is sending a cookie");
  578     $self->sendCookie($self->{user_id}, $self->{session_key});
  579   } else {
  580     $self->killCookie;
  581   }
  582 }
  583 
  584 sub maybe_kill_cookie {
  585   my $self = shift;
  586   $self->killCookie(@_);
  587 }
  588 
  589 sub set_params {
  590   my $self = shift;
  591   my $r = $self->{r};
  592 
  593   # A2 - params are not non-modifiable, with no explanation or workaround given in docs. WTF!
  594   $r->param("user", $self->{user_id});
  595   $r->param("key", $self->{session_key});
  596   $r->param("passwd", "");
  597 
  598   debug("params user='", $r->param("user"), "' key='", $r->param("key"), "' passwd='", $r->param("passwd"), "'");
  599 }
  600 
  601 ################################################################################
  602 # Password management
  603 ################################################################################
  604 
  605 sub checkPassword {
  606   my ($self, $userID, $possibleClearPassword) = @_;
  607   my $db = $self->{r}->db;
  608 
  609   my $Password = $db->getPassword($userID); # checked
  610   if (defined $Password) {
  611     # check against WW password database
  612     my $possibleCryptPassword = crypt $possibleClearPassword, $Password->password;
  613     if ($possibleCryptPassword eq $Password->password) {
  614       $self->write_log_entry("AUTH WWDB: password accepted");
  615       return 1;
  616     } else {
  617       if ($self->can("site_checkPassword")) {
  618         $self->write_log_entry("AUTH WWDB: password rejected, deferring to site_checkPassword");
  619         return $self->site_checkPassword($userID, $possibleClearPassword);
  620       } else {
  621         $self->write_log_entry("AUTH WWDB: password rejected");
  622         return 0;
  623       }
  624     }
  625   } else {
  626     $self->write_log_entry("AUTH WWDB: user has no password record");
  627     return 0;
  628   }
  629 }
  630 
  631 # Site-specific password checking
  632 #
  633 # The site_checkPassword routine can be used to provide a hook to your institution's
  634 # authentication system. If authentication against the  course's password database, the
  635 # method $self->site_checkPassword($userID, $clearTextPassword) is called. If this
  636 # method returns a true value, authentication succeeds.
  637 #
  638 # Here is an example site_checkPassword which checks the password against the Ohio State
  639 # popmail server:
  640 #   sub site_checkPassword {
  641 #     my ($self, $userID, $clearTextPassword) = @_;
  642 #     use Net::POP3;
  643 #     my $pop = Net::POP3->new('pop.service.ohio-state.edu', Timeout => 60);
  644 #     if ($pop->login($userID, $clearTextPassword)) {
  645 #       return 1;
  646 #     }
  647 #     return 0;
  648 #   }
  649 #
  650 # Since you have access to the WeBWorK::Authen object, the possibilities are limitless!
  651 # This example checks the password against the system password database and updates the
  652 # user's password in the course database if it succeeds:
  653 #   sub site_checkPassword {
  654 #     my ($self, $userID, $clearTextPassword) = @_;
  655 #     my $realCryptPassword = (getpwnam $userID)[1] or return 0;
  656 #     my $possibleCryptPassword = crypt($possibleClearPassword, $realCryptPassword); # user real PW as salt
  657 #     if ($possibleCryptPassword eq $realCryptPassword) {
  658 #       # update WeBWorK password
  659 #       use WeBWorK::Utils qw(cryptPassword);
  660 #       my $db = $self->{r}->db;
  661 #       my $Password = $db->getPassword($userID);
  662 #       my $pass = cryptPassword($clearTextPassword);
  663 #       $Password->password($pass);
  664 #       $db->putPassword($Password);
  665 #       return 1;
  666 #     } else {
  667 #       return 0;
  668 #     }
  669 #   }
  670 
  671 ################################################################################
  672 # Session key management
  673 ################################################################################
  674 
  675 sub unexpired_session_exists {
  676   my ($self, $userID) = @_;
  677   my $ce = $self->{r}->ce;
  678   my $db = $self->{r}->db;
  679 
  680   my $Key = $db->getKey($userID); # checked
  681   return 0 unless defined $Key;
  682   if (time <= $Key->timestamp()+$ce->{sessionKeyTimeout}) {
  683     # unexpired, but leave timestamp alone
  684     return 1;
  685   } else {
  686     # expired -- delete key
  687     # NEW: no longer delete the key here -- a user re-visiting with a formerly-valid key should
  688     # always get a "session expired" message. formerly, if they i.e. reload the login screen
  689     # the message disappears, which is confusing (i claim ;)
  690     #$db->deleteKey($userID);
  691     return 0;
  692   }
  693 }
  694 
  695 # clobbers any existing session for this $userID
  696 # if $newKey is not specified, a random key is generated
  697 # the key is returned
  698 sub create_session {
  699   my ($self, $userID, $newKey) = @_;
  700   my $ce = $self->{r}->ce;
  701   my $db = $self->{r}->db;
  702 
  703   my $timestamp = time;
  704   unless ($newKey) {
  705     my @chars = @{ $ce->{sessionKeyChars} };
  706     my $length = $ce->{sessionKeyLength};
  707 
  708     srand;
  709     $newKey = join ("", @chars[map rand(@chars), 1 .. $length]);
  710   }
  711 
  712   my $Key = $db->newKey(user_id=>$userID, key=>$newKey, timestamp=>$timestamp);
  713   # DBFIXME this should be a REPLACE
  714   eval { $db->deleteKey($userID) };
  715   $db->addKey($Key);
  716 
  717   #if ($ce -> {session_management_via} eq "session_cookie"),
  718   #    then the subroutine maybe_send_cookie should send a cookie.
  719 
  720   return $newKey;
  721 }
  722 
  723 # returns ($sessionExists, $keyMatches, $timestampValid)
  724 # if $updateTimestamp is true, the timestamp on a valid session is updated
  725 sub check_session {
  726   my ($self, $userID, $possibleKey, $updateTimestamp) = @_;
  727   my $ce = $self->{r}->ce;
  728   my $db = $self->{r}->db;
  729 
  730   my $Key = $db->getKey($userID); # checked
  731   return 0 unless defined $Key;
  732   my $keyMatches = (defined $possibleKey and $possibleKey eq $Key->key);
  733 
  734   my $timestampValid=0;
  735   if ($ce -> {session_management_via} eq "session_cookie" and defined($self->{cookie_timestamp})) {
  736     $timestampValid = (time <= $self -> {cookie_timestamp} + $ce->{sessionKeyTimeout});
  737   } else {
  738     $timestampValid = (time <= $Key->timestamp()+$ce->{sessionKeyTimeout});
  739     if ($keyMatches and $timestampValid and $updateTimestamp) {
  740       $Key->timestamp(time);
  741       $db->putKey($Key);
  742     }
  743   }
  744   return (1, $keyMatches, $timestampValid);
  745 }
  746 
  747 sub killSession {
  748   my $self = shift;
  749 
  750   my $r = $self -> {r};
  751   my $ce = $r -> {ce};
  752   my $db = $r -> {db};
  753 
  754   $self -> forget_verification;
  755   if ($ce -> {session_management_via} eq "session_cookie")  {
  756     $self -> killCookie();
  757   }
  758 
  759   my $userID = $r -> {user_id};
  760   if (defined($userID)) {
  761      $db -> deleteKey($userID);
  762   }
  763 }
  764 
  765 
  766 ################################################################################
  767 # Cookie management
  768 ################################################################################
  769 
  770 sub fetchCookie {
  771   my $self = shift;
  772   my $r = $self->{r};
  773   my $ce = $r->ce;
  774   my $urlpath = $r->urlpath;
  775 
  776   my $courseID = $urlpath->arg("courseID");
  777 
  778   # AP2 - Apache2::Cookie needs $r, Apache::Cookie doesn't
  779     #my %cookies = WeBWorK::Cookie->fetch( MP2 ? $r : () );
  780     #my $cookie = $cookies{"WeBWorKCourseAuthen.$courseID"};
  781 
  782   my $cookie = undef;
  783   if (MP2) {
  784 
  785     my $jar = undef;
  786     eval {
  787             $jar = $r->jar; #table of cookies
  788       };
  789       if (ref $@ and $@->isa("APR::Request::Error") ) {
  790       debug("Error parsing cookies, will use a partial result");
  791           $jar = $@->jar; # table of successfully parsed cookies
  792       };
  793     if ($jar) {
  794       $cookie = uri_unescape($jar->get("WeBWorKCourseAuthen.$courseID"));
  795     };
  796   } else {
  797     my %cookies = WeBWorK::Cookie->fetch();
  798     $cookie = $cookies{"WeBWorKCourseAuthen.$courseID"};
  799     if ($cookie) {
  800       debug("found a cookie for this course: '", $cookie->as_string, "'");
  801       $cookie = $cookie->value;
  802     }
  803   }
  804 
  805   if ($cookie) {
  806         #debug("found a cookie for this course: '", $cookie->as_string, "'");
  807         #debug("cookie has this value: '", $cookie->value, "'");
  808         #my ($userID, $key) = split "\t", $cookie->value;
  809         debug("cookie has this value: '", $cookie, "'");
  810         my ($userID, $key, $timestamp) = split "\t", $cookie;
  811     if (defined $userID and defined $key and $userID ne "" and $key ne "") {
  812       debug("looks good, returning userID='$userID' key='$key'");
  813       return $userID, $key, $timestamp;
  814     } else {
  815       debug("malformed cookie. returning nothing.");
  816       return;
  817     }
  818   } else {
  819     debug("found no cookie for this course. returning nothing.");
  820     return;
  821   }
  822 }
  823 
  824 sub sendCookie {
  825   my ($self, $userID, $key) = @_;
  826   my $r = $self->{r};
  827   my $ce = $r->ce;
  828 
  829   my $courseID = $r->urlpath->arg("courseID");
  830 
  831   my $timestamp = time();
  832 
  833   my $cookie = WeBWorK::Cookie->new($r,
  834     -name    => "WeBWorKCourseAuthen.$courseID",
  835     -value   => "$userID\t$key\t$timestamp",
  836     -path    => $ce->{webworkURLRoot},
  837     -secure  => 0,
  838   );
  839 
  840   if ($ce->{session_management_via} ne "session_cookie") {
  841     my $expires = time2str("%a, %d-%h-%Y %H:%M:%S %Z", time+COOKIE_LIFESPAN, "GMT");
  842     $cookie -> expires($expires);
  843   }
  844   if ($r->hostname ne "localhost" && $r->hostname ne "127.0.0.1") {
  845     $cookie -> domain($r->hostname);    # if $r->hostname = "localhost" or "127.0.0.1", then this must be omitted.
  846   }
  847 
  848   #debug("about to add Set-Cookie header with this string: '", $cookie->as_string, "'");
  849   eval {$r->headers_out->set("Set-Cookie" => $cookie->as_string);};
  850   if ($@) {croak $@; }
  851 }
  852 
  853 sub killCookie {
  854   my ($self) = @_;
  855   my $r = $self->{r};
  856   my $ce = $r->ce;
  857 
  858   my $courseID = $r->urlpath->arg("courseID");
  859 
  860   my $expires = time2str("%a, %d-%h-%Y %H:%M:%S %Z", time-60*60*24, "GMT");
  861   my $cookie = WeBWorK::Cookie->new($r,
  862     -name => "WeBWorKCourseAuthen.$courseID",
  863     -value => "\t",
  864     -expires => $expires,
  865     -path => $ce->{webworkURLRoot},
  866     -secure => 0,
  867   );
  868   if ($r->hostname ne "localhost" && $r->hostname ne "127.0.0.1") {
  869     $cookie -> domain($r->hostname);  # if $r->hostname = "localhost" or "127.0.0.1", then this must be omitted.
  870   }
  871 
  872   #debug( "killCookie is about to set an expired cookie");
  873   #debug("about to add Set-Cookie header with this string: '", $cookie->as_string, "'");
  874   eval {$r->headers_out->set("Set-Cookie" => $cookie->as_string);};
  875   if ($@) {croak $@; }
  876 }
  877 
  878 ################################################################################
  879 # Utilities
  880 ################################################################################
  881 
  882 sub write_log_entry {
  883   my ($self, $message) = @_;
  884   my $r = $self->{r};
  885   my $ce = $r->ce;
  886 
  887   my $user_id = defined $self->{user_id} ? $self->{user_id} : "";
  888   my $login_type = defined $self->{login_type} ? $self->{login_type} : "";
  889   my $credential_source = defined $self->{credential_source} ? $self->{credential_source} : "";
  890 
  891   my ($remote_host, $remote_port);
  892   if (MP2) {
  893     $remote_host = $r->connection->remote_addr->ip_get || "UNKNOWN";
  894     $remote_port = $r->connection->remote_addr->port || "UNKNOWN";
  895   } else {
  896     ($remote_port, $remote_host) = unpack_sockaddr_in($r->connection->remote_addr);
  897     $remote_host = defined $remote_host ? inet_ntoa($remote_host) : "UNKNOWN";
  898     $remote_port = "UNKNOWN" unless defined $remote_port;
  899   }
  900   my $user_agent = $r->headers_in->{"User-Agent"};
  901 
  902   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";
  903   debug("Writing to login log: '$log_msg'.\n");
  904   writeCourseLog($ce, "login_log", $log_msg);
  905 }
  906 
  907 1;
  908 

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9