Parent Directory
| 
Revision Log
made authentication correction suggested by Bill Wheeler in bug #2026
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 |