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

View of /trunk/webwork2/lib/WeBWorK/Authen.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 7023 - (download) (as text) (annotate)
Thu Aug 25 13:28:08 2011 UTC (8 years, 3 months ago) by gage
File size: 21997 byte(s)
localization updates,
added a fix for Authen.pm which unescapes cookie data.
returned library browser 2 to the lineup



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

aubreyja at gmail dot com
ViewVC Help
Powered by ViewVC 1.0.9