Parent Directory
| 
Revision Log
Check for and accept common misspellings of lis_person_sourced_id
1 ################################################################################ 2 # WeBWorK Online Homework Delivery System 3 # Copyright © 2000-2012 The WeBWorK Project, http://openwebwork.sf.net/ 4 # $CVSHeader: /webwork/cvs/system/webwork2/lib/WeBWorK/Authen/LTIBasic.pm,v 1.1 2012/05/17 18:50:11 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::LTIBasic; 18 use base qw/WeBWorK::Authen/; 19 20 =head1 NAME 21 22 WeBWorK::Authen::LTIBasic - Authenticate from a Learning Management System 23 via the IMS LTI Basic/OAuth protocol. 24 25 =cut 26 27 use strict; 28 use warnings; 29 use Carp; 30 use WeBWorK::Debug; 31 use DBI; 32 use WeBWorK::CGI; 33 use WeBWorK::Utils qw(formatDateTime); 34 use WeBWorK::Localize; 35 use URI::Escape; 36 use Net::OAuth; 37 use mod_perl; 38 use constant MP2 => ( exists $ENV{MOD_PERL_API_VERSION} and $ENV{MOD_PERL_API_VERSION} >= 2 ); 39 40 $Net::OAuth::PROTOCOL_VERSION = Net::OAuth::PROTOCOL_VERSION_1_0A; 41 42 #$WeBWorK::Debug::Enabled = 1; 43 44 BEGIN { 45 if (MP2) { 46 require APR::SockAddr; 47 APR::SockAddr->import(); 48 require Apache2::Connection; 49 Apache2::Connection->import(); 50 require APR::Request::Error; 51 APR::Request::Error->import; 52 } 53 } 54 55 our $GENERIC_ERROR_MESSAGE = 56 "Your authentication failed. Please return to " 57 . "your Course Management System (e.g., Oncourse, Moodle, " 58 . "Blackboard, Canvas, Sakai, etc.) and login again."; 59 our $GENERIC_MISSING_USER_ID_ERROR_MESSAGE = 60 "Your authentication failed. Please return to " 61 . "your Course Management System (e.g., Oncourse, Moodle, " 62 . "Blackboard, Canvas, Sakai, etc.) and login again."; 63 our $GENERIC_DENIED_LOGIN_ERROR_MESSAGE = 64 "You are not permitted to login into this site at this time. " 65 . "Please speak with your instructor."; 66 our $GENERIC_UNKNOWN_USER_ERROR_MESSAGE = 67 "This username does not appear on the roster for this WeBWorK site." ; 68 our $GENERIC_UNKNOWN_INSTRUCTOR_ERROR_MESSAGE = 69 "You have attemped to access this site as an instructor without prior authorization."; 70 71 =head1 CONSTRUCTOR 72 73 =over 74 75 =item new($r) 76 77 Instantiates a new WeBWorK::Authen object for the given WeBWorK::Requst ($r). 78 79 =cut 80 81 sub new { 82 my ($invocant, $r) = @_; 83 my $class = ref($invocant) || $invocant; 84 my $self = { 85 r => $r, 86 }; 87 #initialize 88 bless $self, $class; 89 return $self; 90 } 91 92 =back 93 94 =cut 95 96 97 98 99 ## this is only overridden for debug logging 100 #sub verify { 101 # debug("BEGIN LTIBasic VERIFY"); 102 # my $result = $_[0]->SUPER::verify(@_[1..$#_]); 103 # debug("END LTIBasic VERIFY"); 104 # return $result; 105 #} 106 107 # This module is similar to the base class, with these differences: 108 # 1. no WeBWorK guest/practice logins 109 # 2. uses the Key database to store nonces, where 110 # the $Key -> username = the nonce 111 # $Key -> key = "nonce" 112 # $Key -> timestamp = the nonce's timestamp 113 # 3. when this method is used, there needs to be a CRON job 114 # to delete old nonce records 115 # 4. A program ww_purge_old_nonces is available for 116 # deleting old nonce records. It should be placed 117 # in webwork2/system/bin 118 119 ######## 120 # Example of parameters forwarded by a Course Management System 121 #user_id=wheeler 122 #roles=Instructor 123 # 124 #lis_person_name_full=William+H.+Wheeler 125 #lis_person_name_family=Wheeler 126 #lis_person_contact_email_primary=wheeler%40indiana.edu 127 #lis_person_sourcedid=wheeler 128 #lis_person_name_given=William+H. 129 # 130 #basiclti_submit=Press+to+continue+to+external+tool. 131 #lti_version=LTI-1p0 132 #lti_message_type=basic-lti-launch-request 133 # 134 #context_id=a75a6608-3698-4b62-803d-063040fce113 135 #context_title=Math+Tools+Pages 136 #context_label=Math+Tools+Pages 137 # 138 #resource_link_description=Linking+to+WeBWorK%40IU 139 #resource_link_id=109f9125-c711-4151-8601-4567518aed82 140 #resource_link_title=WeBWorK+LTI 141 # 142 #launch_presentation_locale=en_US 143 # 144 #ext_sakai_serverid=esappo06 145 #ext_sakai_server=https%3A%2F%2Foncourse.iu.edu 146 #ext_sakai_session=8991b6d6c83c085f5ebb8707048e6631c946310870d6147e9e5e619b0686dafc736891ace760a6b8 147 # 148 #oauth_version=1.0 149 #oauth_consumer_key=webwork 150 #oauth_signature=fxcs0nuFgvSGQGnJck59Y2w8VHs%3D 151 #oauth_nonce=201683935212232 152 #oauth_signature_method=HMAC-SHA1 153 #oauth_callback=about%3Ablank 154 #oauth_timestamp=1309888775 155 # 156 #custom_semster=? 157 #custom_section=? 158 159 sub request_has_data_for_this_verification_module { 160 #debug("LTIBasic has been called for data verification"); 161 my $self = shift; 162 my $r = $self -> {r}; 163 if (!(defined $r->param("oauth_consumer_key")) 164 or !(defined $r -> param("oauth_signature")) 165 or !(defined $r -> param("oauth_nonce")) 166 or !(defined $r -> param("oauth_timestamp")) ) { 167 #debug("LTIBasic returning that it has insufficent data"); 168 return(0); 169 } else { 170 return(1); 171 } 172 } 173 174 sub get_credentials { 175 my ($self) = @_; 176 my $r = $self->{r}; 177 my $ce = $r -> {ce}; 178 179 #disable password login 180 $self->{external_auth} = 1; 181 182 # if at least the user ID is available in request parameters 183 if (defined $r->param("user_id")) 184 { 185 map {$self -> {$_ -> [0]} = $r -> param($_ -> [1]);} 186 ( 187 #['user_id', 'lis_person_sourcedid'], 188 ['role', 'roles'], 189 ['last_name' , 'lis_person_name_family'], 190 ['first_name', 'lis_person_name_given'], 191 ['context_id', 'context_id'], 192 ['oauth_consumer_key', 'oauth_consumer_key'], 193 ['oauth_signature', 'oauth_signature'], 194 ['oauth_nonce', 'oauth_nonce'], 195 ['oauth_timestamp', 'oauth_timestamp'], 196 ['semester', 'custom_semester'], 197 ['section', 'custom_section'], 198 ); 199 200 # The following lines were substituted for the commented out line above 201 # because some LMS's misspell the lis_person_sourced_id parameter name 202 if (defined($r -> param("lis_person_sourced_id"))) { 203 $self -> {user_id} = $r -> param("lis_person_sourced_id"); 204 } elsif (defined($r -> param("lis_person_sourcedid"))) { 205 $self -> {user_id} = $r -> param("lis_person_sourcedid"); 206 } elsif (defined($r -> param("lis_person_source_id"))) { 207 $self -> {user_id} = $r -> param("lis_person_source_id"); 208 } elsif (defined($r -> param("lis_person_sourceid"))) { 209 $self -> {user_id} = $r -> param("lis_person_sourceid"); 210 } else { 211 undef($self ->{user_id}); 212 } 213 214 215 $self -> {email} = uri_unescape($r -> param("lis_person_contact_email_primary")); 216 if (!defined($self->{user_id})) { 217 $self->{user_id} = $self -> {email}; 218 } 219 if (defined $ce -> {analyze_context_id}) { 220 $ce -> {analyze_context_id} ($self) ; 221 } 222 if (!defined($self -> {section})) { 223 $self -> {section} = "unknown"; 224 } 225 $self->{login_type} = "normal"; 226 $self -> {credential_source} = "LTIBasic"; 227 return 1; 228 } 229 return 0; 230 } 231 232 # minor modification of method in superclass 233 sub check_user { 234 my $self = shift; 235 my $r = $self->{r}; 236 my ($ce, $db, $authz) = map {$r -> $_ ;} ('ce', 'db', 'authz'); 237 238 my $user_id = $self->{user_id}; 239 240 if (!defined($user_id) or (defined $user_id and $user_id eq "")) { 241 $self->{log_error} = "no user id specified"; 242 $self->{error} = $r->maketext($GENERIC_MISSING_USER_ID_ERROR_MESSAGE); 243 return 0; 244 } 245 246 my $User = $db->getUser($user_id); 247 248 if (!$User) { 249 if ( defined($r -> param("lis_person_sourcedid")) 250 or defined($r -> param("lis_person_sourced_id")) 251 or defined($r -> param("lis_person_source_id")) 252 or defined($r -> param("lis_person_sourceid")) ) { 253 return 1; #This may be a new user coming in from a LMS via LTI. 254 } else { 255 $self->{log_error} .= "LOGIN FAILED $user_id - user unknonw"; 256 $self->{error} = $r->maketext("Username presented: " . $user_id . "<br />" . $GENERIC_UNKNOWN_USER_ERROR_MESSAGE); 257 return 0; 258 } 259 } 260 261 unless ($ce->status_abbrev_has_behavior($User->status, "allow_course_access")) { 262 $self->{log_error} .= "LOGIN FAILED $user_id - course access denied"; 263 $self->{error} = $r->maktext($GENERIC_DENIED_LOGIN_ERROR_MESSAGE); 264 return 0; 265 } 266 267 unless ($authz->hasPermissions($user_id, "login")) { 268 $self->{log_error} .= "LOGIN FAILED $user_id - no permission to login"; 269 $self->{error} = $r->maketext($GENERIC_DENIED_LOGIN_ERROR_MESSAGE); 270 return 0; 271 } 272 273 return 1; 274 } 275 276 # disable practice users 277 sub verify_practice_user { return(0) ;} 278 279 sub verify_normal_user 280 { 281 my $self = shift; 282 my ($r, $user_id, $session_key) 283 = map {$self -> {$_};} ('r', 'user_id', 'session_key'); 284 285 # Call check_session in order to destroy any existing session cookies and Key table sessions 286 my ($sessionExists, $keyMatches, $timestampValid) = $self->check_session($user_id, $session_key, 0); 287 debug("sessionExists='", $sessionExists, "' keyMatches='", $keyMatches, "' timestampValid='", $timestampValid, "'"); 288 289 #debug("Mark D"); 290 my $auth_result = $self->authenticate; 291 #debug("Mark E"); 292 #debug("auth_result=|${auth_result}|"); 293 294 if ($auth_result eq "1") 295 { 296 #debug("Mark F"); 297 #debug("About to call create_session."); 298 $self->{session_key} = $self->create_session($user_id); 299 #debug("Mark G"); 300 #debug("session_key=|" . $self -> {session_key} . "|."); 301 return 1; 302 } 303 else 304 { 305 $self->{error} = $r->maketext($auth_result); 306 $self-> {log_error} .= "LOGIN FAILED $user_id - authentication failed: ". $self->{error}; 307 return 0; 308 } 309 } 310 311 sub authenticate 312 { 313 my $self = shift; 314 my ($r, $user ) = map {$self -> {$_};} ('r', 'user_id'); 315 #debug("user=|${user}|"); 316 #debug "ref(r) = |". ref($r) . "|"; 317 #debug "ref of r->{paramcache} = |" . ref($r -> {paramcache}) . "|"; 318 #debug "request_method = |" . $r -> request_method . "|"; 319 my $ce = $r -> ce; 320 my $db = $r -> db; 321 my $courseName = $r -> ce -> {'courseName'}; 322 my $webmaster= $ce ->{Local_Email_Addresses} -> {Webmaster}; 323 my $verify_code=0; 324 my $timestamp=0; 325 326 # Check nonce to see whether request is legitimate 327 #debug("Nonce = |" . $self-> {oauth_nonce} . "|"); 328 my $nonce = WeBWorK::Authen::LTIBasic::Nonce -> new($r, $self -> {oauth_nonce}, $self -> {oauth_timestamp}); 329 if (!($nonce -> ok ) ) 330 { 331 #croak ($r->maketext("Bad Nonce for user " . $self->{user_id} . ": Nonce = " . $self -> {oauth_nonce} . ", Nonce_timestamp = " . $self -> {oauth_timestamp} . ", at time " . time())); 332 #debug( "eval failed: ", $@, "<br /><br />"; print_keys($r);); 333 $self -> {error} .= $r->maketext($GENERIC_ERROR_MESSAGE 334 . ": Something was wrong with your Nonce LTI parameters. " 335 . "If this recurs, please speak with your instructor"); 336 return 0; 337 } 338 #debug( "r->param(oauth_signature) = |" . $r -> param("oauth_signature") . "|"); 339 my %request_hash; 340 my @keys = keys %{$r-> {paramcache}}; 341 foreach my $key (@keys) { 342 $request_hash{$key} = $r -> param($key); 343 } 344 my $requestHash = \%request_hash; 345 #foreach my $key (@keys) { 346 # debug( "$key -> |" . $requestHash->{$key} . "|"); 347 #} 348 349 my $request; 350 eval 351 { 352 $request = Net::OAuth -> request("request token") -> from_hash($requestHash, 353 request_url => $ce -> {LTIBasicToThisSiteURL}, 354 request_method => "POST", 355 consumer_secret => $ce -> {LTIBasicConsumerSecret}, 356 ); 357 }; 358 359 if ($@) 360 { 361 #debug("construction of Net::OAuth object failed: $@"); 362 #debug( "eval failed: ", $@, "<br /><br />"; print_keys($r);); 363 $self -> {error} = $r->maketext("Your authentication failed. Please return to Oncourse and login again."); 364 $self -> {error} = $r->maketext("Something was wrong with your LTI parameters. " 365 . "If this recurs, please speak with your instructor"); 366 return 0; 367 } 368 else 369 { 370 if (! $request -> verify) 371 { 372 #debug("request-> verify failed"); 373 #debug("<h2> oauthTest2: OAuth verification Failed</h2> "; print_keys($r)); 374 $self -> {error} = $r->maketext("Your authentication failed. Please return to Oncourse and login again."); 375 $self -> {error} = $r->maketext("Your LTI OAuth verification failed. " 376 . "If this recurs, please speak with your instructor"); 377 return 0; 378 } 379 else 380 { 381 #debug("<h2> oauthTest2: OAuth verification SUCCEEDED !! </h2>"); 382 my $userID = $self->{user_id}; 383 my $LTIrolesString = $r -> param("roles"); 384 my @LTIroles = split /,/, $LTIrolesString; 385 my $nr = scalar(@LTIroles); 386 if (! defined($ce -> {userRoles} -> {$ce -> {LMSrolesToWeBWorKroles} -> {$LTIroles[0]}})) { 387 croak("Cannot find a WeBWorK role that corresponds to the LMS role of " 388 . $LTIroles[0] ."."); 389 } 390 my $LTI_webwork_permissionLevel 391 = $ce -> {userRoles} -> {$ce -> {LMSrolesToWeBWorKroles} -> {$LTIroles[0]}}; 392 if ($nr > 1) { 393 for (my $j =1; $j < $nr; $j++) { 394 if ($LTI_webwork_permissionLevel 395 < $ce -> {userRoles} -> {$ce -> {LMSrolesToWeBWorKroles} -> {$LTIroles[$j]}}) { 396 $LTI_webwork_permissionLevel 397 = $ce -> {userRoles} -> {$ce -> {LMSrolesToWeBWorKroles} -> {$LTIroles[$j]}}; 398 } 399 } 400 } 401 if (! $db -> existsUser($userID) ) 402 { # New User. Create User record 403 if ($LTI_webwork_permissionLevel > $ce ->{userRoles} -> {"ta"}) { 404 croak $r->maketext($GENERIC_UNKNOWN_INSTRUCTOR_ERROR_MESSAGE); 405 } 406 my $newUser = $db -> newUser(); 407 $newUser -> user_id($userID); 408 $newUser -> last_name($self -> {last_name}); 409 $newUser -> first_name($self -> {first_name}); 410 $newUser -> email_address($self -> {email}); 411 $newUser -> status("C"); 412 $newUser -> section(($LTI_webwork_permissionLevel > $ce -> {userRoles} -> {"student"}) ? 413 "Admin" : (defined($self -> {section})) ? $self -> {section} : ""); 414 $newUser -> comment(formatDateTime(time, "local")); 415 $db -> addUser($newUser); 416 $self->write_log_entry("New user $userID added via LTIBasic login"); 417 # Assign permssion level 418 my $newPermissionLevel = $db -> newPermissionLevel(); 419 $newPermissionLevel -> user_id($userID); 420 $newPermissionLevel -> permission($LTI_webwork_permissionLevel); 421 $db -> addPermissionLevel($newPermissionLevel); 422 $r -> authz -> {PermissionLevel} = $newPermissionLevel; #cache the Permission Level Record. 423 # Assign existing sets 424 # This module is not a subclass of WeBWorK::ContentGenerator::Instuctor, 425 # do the methods defined therein for assigning problem sets and problems 426 # to users are not available for use here. 427 # Therefore, we have to resort to the lower level methods in WeBWorK::DB. 428 my $numberOfProblemsAssigned = 0; 429 my %globalProblemsBySet=(); 430 my @globalSetIDs = $db->listGlobalSets; 431 my @GlobalSets = $db->getGlobalSets(@globalSetIDs); 432 my $open_cut = time() + 24*3600; 433 my $globalSet; 434 foreach $globalSet (@GlobalSets) { 435 if (defined($globalSet) and $globalSet -> open_date < $open_cut) { 436 my @GlobalProblems = grep { defined $_ } $db->getAllGlobalProblems($globalSet -> set_id); 437 $globalProblemsBySet{$globalSet->set_id} = \@GlobalProblems; 438 $numberOfProblemsAssigned += scalar(@GlobalProblems); 439 } 440 } 441 my $reasonableNumberOfDays = int($numberOfProblemsAssigned / $ce->{reasonableProblemsPerDayMakeup}) +1; 442 if ($reasonableNumberOfDays < 2) {$reasonableNumberOfDays = 2;} 443 my ($sec, $min, $day, $monthDay, $month, $year, $weekDay, $yearDay, $isdst) = localtime(); 444 my $niceDueDay = $yearDay + 1 + $reasonableNumberOfDays; 445 my $niceDueTime = Time::Local::timelocal_nocheck(0,30,8,$niceDueDay,0,$year); 446 ($sec, $min, $day, $monthDay, $month, $year, $weekDay, $yearDay, $isdst) = localtime($niceDueTime); 447 if ($weekDay == 0) {$niceDueDay +=1;} 448 elsif ($weekDay == 6) {$niceDueDay += 2;} 449 my $niceAnswerTime = $niceDueTime + 600; 450 my $due_cut = time() + 2*24*3600; 451 my $userSet; 452 my $userProblem; 453 foreach $globalSet (@GlobalSets) 454 { 455 if (defined($globalSet)) 456 { 457 if (defined($ce -> {"adjustDueDatesForLateAdds"}) and $ce -> {"adjustDueDatesForLateAdds"} 458 and $globalSet -> open_date < $open_cut and $globalSet -> due_date < $due_cut 459 ) 460 { 461 if (not $db -> existsUserSet($userID, $globalSet -> set_id ) ) 462 { 463 $userSet = $db -> newUserSet(); 464 $userSet -> user_id($userID); 465 $userSet -> set_id($globalSet -> set_id); 466 # $userSet -> psvn(int(10**12 * rand())); 467 # $userSet -> open_date(0); 468 $userSet -> due_date($niceDueTime); 469 $userSet -> answer_date($niceAnswerTime); 470 $db -> addUserSet($userSet); 471 } 472 } 473 else 474 { 475 if (not $db -> existsUserSet($userID, $globalSet -> set_id ) ) { 476 $userSet = $db -> newUserSet(); 477 $userSet -> user_id($userID); 478 $userSet -> set_id($globalSet -> set_id); 479 # $userSet -> psvn(int(10**12 * rand())); 480 # $userSet -> open_date(0); 481 # $userSet -> due_date(0); 482 # $userSet -> answer_date(0); 483 $db -> addUserSet($userSet); 484 } 485 } 486 foreach my $globalProblem ( @{$globalProblemsBySet{$globalSet -> set_id}} ) { 487 if (defined($globalProblem)) { 488 if (not $db -> existsUserProblem($userID, $globalSet -> set_id, $globalProblem -> problem_id)) { 489 $userProblem = $db -> newUserProblem(); 490 $userProblem -> user_id($userID); 491 $userProblem -> set_id($globalSet -> set_id); 492 $userProblem -> problem_id($globalProblem -> problem_id); 493 $userProblem -> problem_seed(int(10**4 * rand())); 494 $userProblem -> {status} = 0; 495 $userProblem -> {attempted} = 0; 496 $userProblem -> {num_correct} = 0; 497 $userProblem -> {num_incorrect} = 0; 498 $userProblem -> {last_answer} = ""; 499 500 $db -> addUserProblem($userProblem); 501 } 502 } 503 } 504 } 505 } 506 } 507 else 508 { # Existing user. Possibly modify demographic information and permission level. 509 my $user = $db -> getUser($userID); 510 my $permissionLevel = $db -> getPermissionLevel($userID); 511 if (($user -> last_name() eq "Teacher" and $user -> first_name() eq "The") 512 or (defined($permissionLevel -> permission) 513 and $permissionLevel -> permission > $ce -> {userRoles} -> {professor})) 514 { #This is the instructor of record or an administrator. No changes permitted via LTI. 515 } 516 else 517 { 518 my $change_made = 0; 519 if ($user -> last_name ne $self -> {last_name}) 520 { 521 $user -> last_name($self -> {last_name}); 522 $change_made = 1; 523 } 524 if ($user -> first_name ne $self -> {first_name}) 525 { 526 $user -> first_name($self -> {first_name}); 527 $change_made = 1; 528 } 529 if ($user -> email_address ne $self -> {email}) 530 { 531 $user -> email_address($self -> {email}); 532 $change_made = 1; 533 } 534 if ($user -> status ne "C") 535 { 536 $user -> status("C"); 537 $change_made = 1; 538 } 539 if (defined($permissionLevel -> permission) 540 and $permissionLevel -> permission > $ce ->{userRoles} -> {"student"}) 541 {if ($user -> section ne "Admin") 542 { 543 $user -> section("Admin"); 544 $change_made = 1; 545 } 546 } 547 elsif ($LTI_webwork_permissionLevel > $ce -> {userRoles}->{"student"} 548 and (!defined($user -> section) or $user -> section ne "Admin") ) 549 { 550 $user -> section("Admin"); 551 $change_made = 1; 552 } 553 elsif (defined ($self -> {"section"}) 554 and (! defined($user -> section) 555 or ($user -> section ne $self -> {"section"} 556 and $self -> {"section"} ne "" 557 and $user -> section ne "Admin" 558 ) 559 ) 560 ) 561 { 562 $user -> section($self -> {"section"}); 563 $change_made = 1; 564 } 565 if ($change_made) 566 { 567 $user -> comment(formatDateTime(time, "local")); 568 $db -> putUser($user); 569 $self->write_log_entry("Demographic data for user $userID modified via LTIBasic login"); 570 } 571 # Assign permission level 572 ######## Change due to faulty roles from Oncourse LTIBasic ###### 573 # if (!defined($permissionLevel -> permission) or $permissionLevel -> permission != $LTI_webwork_permissionLevel) 574 if (!defined($permissionLevel -> permission) ) 575 ################################################################# 576 { 577 $permissionLevel -> permission($LTI_webwork_permissionLevel); 578 $db -> putPermissionLevel($permissionLevel); 579 $self->{PermissionLevel} = $permissionLevel; #cache the revised Permission Level Record. 580 $self->write_log_entry("Permission level for user $userID changed to $LTI_webwork_permissionLevel via LTIBasic login"); 581 } 582 } 583 } 584 return 1; 585 } 586 } 587 $self -> {error} = $r->maketext($GENERIC_ERROR_MESSAGE); 588 return(0); 589 } 590 591 592 ################################################################################ 593 ################################################################################ 594 # NONCE SUB-PACKAGE 595 ################################################################################ 596 ################################################################################ 597 598 package WeBWorK::Authen::LTIBasic::Nonce; 599 600 sub new { 601 my ($invocant, $r, $nonce, $timestamp) = @_; 602 my $class = ref($invocant) || $invocant; 603 my $self = { 604 r => $r, 605 nonce => $nonce, 606 timestamp => $timestamp, 607 }; 608 bless $self, $class; 609 return $self; 610 } 611 612 sub ok { 613 my $self = shift; 614 my $r = $self -> {r}; 615 my $ce = $r -> {ce}; 616 if ($self -> {timestamp} < time() - $ce->{NonceLifeTime}) { 617 return 0; 618 } 619 my $db = $self -> {r} -> {db}; 620 my $Key = $db -> getKey($self -> {nonce}); 621 if (! defined($Key) ) { 622 # nonce, timestamp are ok 623 $Key = $db -> newKey(user_id=>$self->{nonce}, 624 key=>"nonce", 625 timestamp=>$self->{"timestamp"}, 626 ); 627 $db -> addKey($Key); 628 return 1; 629 } 630 elsif ( $Key -> timestamp < $self ->{"timestamp"} ) { 631 # nonce, timestamp pair is OK 632 $Key -> timestamp($self -> {"timestamp"}); 633 $db -> put($Key); 634 return 1; 635 } 636 else { 637 return 0; 638 } 639 } 640 641 #sub ok { #### For Testing Purposes only 642 # return 1; 643 #} 644 645 ################################################################################ 646 # END NONCE SUB-PACKAGE 647 ################################################################################ 648 649 sub print_keys { 650 my ($self, $r) = @_; 651 my @keys = keys %{$r-> {paramcache}}; 652 my %request_hash; 653 my $key; 654 foreach $key (@keys) { 655 $request_hash{$key} = $r -> param($key); 656 } 657 my $requestHash = \%request_hash; 658 foreach $key (@keys) { 659 warn "$key -> |" . $requestHash->{$key} . "|"; 660 } 661 } 662 663 664 665 1; 666
| aubreyja at gmail dot com | ViewVC Help |
| Powered by ViewVC 1.0.9 |