[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 7141 - (download) (as text) (annotate)
Tue May 29 19:04:03 2012 UTC (7 years, 6 months ago) by wheeler
File size: 27092 byte(s)
Support for LTI 1.0 authentication from a Course Management System

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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9