Annotation of loncom/lti/ltipassback.pm, revision 1.1
1.1 ! raeburn 1: # The LearningOnline Network with CAPA
! 2: # LTI Consumer Module to receive grades passed back by Provider
! 3: #
! 4: # $Id: ltipassback.pm,v 1.1 2017/11/30 22:41:20 raeburn Exp $
! 5: #
! 6: # Copyright Michigan State University Board of Trustees
! 7: #
! 8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
! 9: #
! 10: # LON-CAPA is free software; you can redistribute it and/or modify
! 11: # it under the terms of the GNU General Public License as published by
! 12: # the Free Software Foundation; either version 2 of the License, or
! 13: # (at your option) any later version.
! 14: #
! 15: # LON-CAPA is distributed in the hope that it will be useful,
! 16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
! 17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
! 18: # GNU General Public License for more details.
! 19: #
! 20: # You should have received a copy of the GNU General Public License
! 21: # along with LON-CAPA; if not, write to the Free Software
! 22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
! 23: #
! 24: # /home/httpd/html/adm/gpl.txt
! 25: #
! 26: # http://www.lon-capa.org/
! 27: #
! 28:
! 29: package Apache::ltipassback;
! 30:
! 31: use strict;
! 32: use Apache::Constants qw(:common :http);
! 33: use Apache::lonnet;
! 34: use Apache::loncommon;
! 35: use Apache::lonacc;
! 36: use LONCAPA::ltiutils;
! 37:
! 38: sub handler {
! 39: my $r = shift;
! 40: my %errors;
! 41: #
! 42: # Retrieve data POSTed by LTI Provider
! 43: #
! 44: &Apache::lonacc::get_posted_cgi($r);
! 45: my $params = {};
! 46: foreach my $key (sort(keys(%env))) {
! 47: if ($key =~ /^form\.(.+)$/) {
! 48: $params->{$1} = $env{$key};
! 49: }
! 50: }
! 51:
! 52: unless (keys(%{$params})) {
! 53: $errors{1} = 1;
! 54: &invalid_request($r,$params,\%errors);
! 55: return OK;
! 56: }
! 57:
! 58: unless ($params->{'oauth_consumer_key'} &&
! 59: $params->{'oauth_nonce'} &&
! 60: $params->{'oauth_timestamp'} &&
! 61: $params->{'oauth_version'} &&
! 62: $params->{'oauth_signature'} &&
! 63: $params->{'oauth_signature_method'}) {
! 64: $errors{2} = 1;
! 65: &invalid_request($r,$params,\%errors);
! 66: return OK;
! 67: }
! 68:
! 69: #
! 70: # Retrieve the signature, digested symb, digested user, and LON-CAPA
! 71: # courseID from the sourcedid in the POSTed data
! 72: #
! 73: unless ($params->{'sourcedid'}) {
! 74: $errors{3} = 1;
! 75: &invalid_request($r,$params,\%errors);
! 76: return OK;
! 77: }
! 78:
! 79: my ($resultsig,$digsymb,$diguser,$cid) = split(/\Q:::\E/,$params->{'sourcedid'});
! 80: unless ($resultsig && $digsymb && $diguser && $cid) {
! 81: $errors{4} = 1;
! 82: &invalid_request($r,$params,\%errors);
! 83: return OK;
! 84: }
! 85:
! 86: my ($cdom,$cnum,$marker,$symb,$uname,$udom);
! 87:
! 88: #
! 89: # Determine the domain and the courseID of the LON-CAPA course to which the
! 90: # launch of LON-CAPA should provide access.
! 91: #
! 92: ($cdom,$cnum) = &LONCAPA::ltiutils::get_loncapa_course($r->dir_config('lonHostID'),
! 93: $cid,\%errors);
! 94: unless ($cdom && $cnum) {
! 95: &invalid_request($r,$params,\%errors);
! 96: return OK;
! 97: }
! 98:
! 99: #
! 100: # Use the digested symb to lookup the real symb in exttools.db
! 101: #
! 102:
! 103: ($marker,$symb,$uname,$udom) =
! 104: &LONCAPA::ltiutils::get_tool_instance($cdom,$cnum,$digsymb,$diguser,\%errors);
! 105:
! 106: unless ($marker) {
! 107: &invalid_request($r,$params,\%errors);
! 108: return OK;
! 109: }
! 110:
! 111: #
! 112: # Retrieve the Consumer key and Consumer secret from the domain configuration
! 113: # for the Tool Provider ID stored in the exttool_$marker.db
! 114: #
! 115:
! 116: my (%toolsettings,%ltitools);
! 117: my ($consumer_secret,$nonce_lifetime) =
! 118: &LONCAPA::ltiutils::get_tool_secret($params->{'oauth_consumer_key'},
! 119: $marker,$symb,$cdom,$cnum,
! 120: \%toolsettings,\%ltitools,\%errors);
! 121:
! 122: #
! 123: # Verify the signed request using the consumer_key and
! 124: # secret for the specific LTI Provider.
! 125: #
! 126:
! 127: my $protocol = 'http';
! 128: if ($ENV{'SERVER_PORT'} == 443) {
! 129: $protocol = 'https';
! 130: }
! 131: unless (LONCAPA::ltiutils::verify_request($params,$protocol,$r->hostname,$r->uri,
! 132: $env{'request.method'},$consumer_secret,
! 133: \%errors)) {
! 134: &invalid_request($r,$params,\%errors);
! 135: return OK;
! 136: }
! 137:
! 138: #
! 139: # Determine if nonce in POSTed data has expired.
! 140: # If unexpired, confirm it has not already been used.
! 141:
! 142: unless (&LONCAPA::ltiutils::check_nonce($params->{'oauth_nonce'},$params->{'oauth_timestamp'},
! 143: $ltitools{'lifetime'},$cdom,$r->dir_config('lonLTIDir'))) {
! 144: $errors{15} = 1;
! 145: &invalid_request($r,$params,\%errors);
! 146: return OK;
! 147: }
! 148:
! 149: #
! 150: # Verify that the sourcedid has not been tampered with,
! 151: # and the gradesecret used to create it is still valid.
! 152: #
! 153:
! 154: unless (&LONCAPA::ltiutils::verify_lis_item($resultsig,'grade',$digsymb,$diguser,$cdom,
! 155: $cnum,\%toolsettings,\%ltitools,\%errors)) {
! 156: &invalid_request($r,$params,\%errors);
! 157: return OK;
! 158: }
! 159:
! 160: #
! 161: # Does the user have an active role in the course which maps to one of
! 162: # the supported LTI roles
! 163: #
! 164:
! 165: if (($uname ne '') && ($udom ne '')) {
! 166: my %maproles;
! 167: if (ref($ltitools{'roles'}) eq 'HASH') {
! 168: %maproles = %{$ltitools{'roles'}};
! 169: }
! 170: unless (keys(%maproles)) {
! 171: $errors{20} = 1;
! 172: &invalid_request($r,$params,\%errors);
! 173: return OK;
! 174: }
! 175: my ($crstype,$hasrole);
! 176: my @allroles = &Apache::lonuserutils::roles_by_context('course',0,$crstype);
! 177: my (%availableroles,$coursepersonnel,$includestudents,%users);
! 178: foreach my $role (@allroles) {
! 179: if (exists($maproles{$role})) {
! 180: $availableroles{$role} = 1;
! 181: if ($role eq 'st') {
! 182: $includestudents = 1;
! 183: } else {
! 184: $coursepersonnel = 1;
! 185: }
! 186: }
! 187: }
! 188: if (keys(%availableroles)) {
! 189: my $courseurl = "/$cdom/$cnum";
! 190: my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname,$courseurl);
! 191: if (keys(%roleshash)) {
! 192: my $now = time;
! 193: foreach my $key (keys(%roleshash)) {
! 194: if ($key =~ m{^\Q$courseurl\E(|/\w+)_(\w+)$}) {
! 195: my ($secgroup,$rolecode) = ($1,$2);
! 196: next if ($rolecode eq 'gr');
! 197: next unless ($availableroles{$rolecode});
! 198: my ($dummy,$end,$start)=split(/\_/,$roleshash{$key});
! 199: next if (defined($end) && $end && ($now > $end));
! 200: next if (defined($start) && $start && ($now < $start));
! 201: $hasrole = 1;
! 202: last;
! 203: }
! 204: }
! 205: }
! 206: }
! 207: unless ($hasrole) {
! 208: $errors{21} = 1;
! 209: &invalid_request($r,$params,\%errors);
! 210: return OK;
! 211: }
! 212: } else {
! 213: $errors{22} = 1;
! 214: &invalid_request($r,$params,\%errors);
! 215: return OK;
! 216: }
! 217:
! 218: #
! 219: # Store result if one was sent in a valid format.
! 220: #
! 221:
! 222:
! 223: my ($result,$resulttype,$lang,$pcf);
! 224: if (exists($params->{'result_resultvaluesourcedid'})) {
! 225: $resulttype = 'decimal';
! 226: } else {
! 227: $resulttype = $params->{'result_resultvaluesourcedid'};
! 228: $resulttype =~ s/(^\s+|\s+)$//g;
! 229: }
! 230: $result = $params->{'result_resultscore_textstring'};
! 231: $result =~ s/(^\s+|\s+)$//g;
! 232: my $posslang = $params->{'result_resultscore_language'};
! 233: $posslang =~ s/(^\s+|\s+)$//g;
! 234: if ($posslang =~ /^\w+(|\-\w+(|\-w+))$/) {
! 235: $lang = $posslang;
! 236: }
! 237: if (($resulttype eq 'ratio') || ($resulttype eq 'decimal') || ($resulttype eq 'percentage')) {
! 238: if ($resulttype eq 'ratio') {
! 239: my ($numerator,$denominator) = split(/\s*\/\s*/,$result,2);
! 240: $numerator =~ s/(^\s+|\s+)$//g;
! 241: $denominator =~ s/(^\s+|\s+)$//g;
! 242: if (($numerator =~ /^\d+$/) && ($denominator =~ /^\d+$/) && ($denominator !=0)) {
! 243: eval {
! 244: $pcf = $numerator/$denominator;
! 245: };
! 246: }
! 247: if ($@) {
! 248: $errors{22} = 1;
! 249: &invalid_request($r,$params,\%errors);
! 250: return OK;
! 251: }
! 252: } elsif ($resulttype eq 'decimal') {
! 253: if (($result ne '') && ($result =~ /^\d*\.?\d*$/)) {
! 254: if ($result eq '.') {
! 255: $result = 0;
! 256: }
! 257: if (($result >= 0) && ($result <= 1)) {
! 258: $pcf = $result;
! 259: }
! 260: }
! 261: } elsif ($resulttype eq 'percentage') {
! 262: if ($result =~ /^(\d+)\s*\%?$/) {
! 263: my $percent = $1;
! 264: if (($percent >= 0) && ($percent <= 100)) {
! 265: $pcf = $percent/100.0;
! 266: }
! 267: }
! 268: }
! 269: if ($pcf ne '') {
! 270: my %newrecord=();
! 271: my $reckey = 'resource.0.solved';
! 272: my %record = &Apache::lonnet::restore($symb,$cdom.'_'.$cnum,$udom,$uname);
! 273: if ($record{'resource.0.awarded'} ne $pcf) {
! 274: $newrecord{'resource.0.awarded'} = $pcf;
! 275: }
! 276: if ($pcf == 0) {
! 277: if ($record{$reckey} ne 'incorrect_by_override') {
! 278: $newrecord{$reckey} = 'incorrect_by_override';
! 279: }
! 280: } else {
! 281: if ($record{$reckey} ne 'correct_by_override') {
! 282: $newrecord{$reckey} = 'correct_by_override';
! 283: }
! 284: }
! 285: if (%newrecord) {
! 286: my $result = &Apache::lonnet::cstore(\%newrecord,$symb,$cdom.'_'.$cnum,
! 287: $udom,$uname);
! 288: if (($result eq 'ok') || ($result eq 'con_delayed')) {
! 289: &success($r,$params->{'sourcedid'},$resulttype,$result,$lang);
! 290: } else {
! 291: $errors{23} = 1;
! 292: &invalid_request($r,$params,\%errors);
! 293: }
! 294: }
! 295: } else {
! 296: $errors{24} = 1;
! 297: &invalid_request($r,$params,\%errors);
! 298: }
! 299: } else {
! 300: $errors{25} = 1;
! 301: &invalid_request($r,$params,\%errors);
! 302: }
! 303: return OK;
! 304: }
! 305:
! 306: sub success {
! 307: my ($r,$sourcedid,$scoretype,$score,$lang) = @_;
! 308: my $date = &Apache::loncommon::utc_string(time);
! 309: &Apache::loncommon::content_type($r,'text/xml');
! 310: $r->send_http_header;
! 311: if ($r->header_only) {
! 312: return;
! 313: }
! 314: $r->print(<<"END");
! 315: <?xml version="1.0" encoding="UTF-8" ?>
! 316: <message_response>
! 317: <lti_message_type>basic-lis-updateresult</lti_message_type>
! 318: <statusinfo>
! 319: <codemajor>Success</codemajor>
! 320: <severity>Status</severity>
! 321: <codeminor>fullsuccess</codeminor>
! 322: <description>Grade updated</description>
! 323: </statusinfo>
! 324: <result>
! 325: <sourcedid>$sourcedid</sourcedid>
! 326: <date>$date</date>
! 327: <resultscore>
! 328: <resultvaluesourcedid>$scoretype</resultvaluesourcedid>
! 329: <textstring>$score</textstring>
! 330: <language>$lang</language>
! 331: </resultscore>
! 332: </result>
! 333: </message_response>
! 334: END
! 335: return;
! 336: }
! 337:
! 338: sub invalid_request {
! 339: my ($r,$params,$errors) = @_;
! 340: my $date = &Apache::loncommon::utc_string(time);
! 341: my ($scoretype,$score,$lang);
! 342: if (ref($params) eq 'HASH') {
! 343: if ($params->{'result_resultvaluesourcedid'} =~ /^\s*(decimal|percentage|ratio)\s*$/) {
! 344: $scoretype = $1;
! 345: }
! 346: if ($scoretype eq 'decimal') {
! 347: if ($params->{'result_resultscore_textstring'} =~ /^\s*(\d*\.?\d*)\s*$/) {
! 348: $score = $1;
! 349: }
! 350: } elsif ($scoretype eq 'ratio') {
! 351: if ($params->{'result_resultscore_textstring'} =~ m{^\s*(\d+)\s*/\s*(\d+)\s*$}) {
! 352: $score = $1.'/'.$2;
! 353: }
! 354: } elsif ($scoretype eq 'percentage') {
! 355: if ($params->{'result_resultscore_textstring'} =~ /^\s*(\d+)\s*(\%?)\s*$/) {
! 356: $score = $1.$2;
! 357: }
! 358: }
! 359: my $posslang = $params->{'result_resultscore_language'};
! 360: $posslang =~ s/(^\s+|\s+)$//g;
! 361: if ($posslang =~ /^\w+(|\-\w+(|\-w+))$/) {
! 362: $lang = $posslang;
! 363: }
! 364: }
! 365: my $errormsg;
! 366: if (ref($errors) eq 'HASH') {
! 367: $errormsg = join(',',keys(%{$errors}));
! 368: }
! 369: &Apache::loncommon::content_type($r,'text/xml');
! 370: $r->send_http_header;
! 371: if ($r->header_only) {
! 372: return;
! 373: }
! 374: $r->print(<<"END");
! 375: <message_response>
! 376: <lti_message_type>basic-lis-updateresult</lti_message_type>
! 377: <statusinfo>
! 378: <codemajor>Failure</codemajor>
! 379: <severity>Error</severity>
! 380: <codeminor>$errormsg</codeminor>
! 381: </statusinfo>
! 382: <result>
! 383: <sourcedid>$params->{'sourcedid'}</sourcedid>
! 384: <statusofresult>interim</statusofresult>
! 385: <date>$date</date>
! 386: <resultscore>
! 387: <resultvaluesourcedid>$scoretype</resultvaluesourcedid>
! 388: <textstring>$score</textstring>
! 389: <language>$lang</language>
! 390: </resultscore>
! 391: </result>
! 392: </message_response>
! 393: END
! 394: return;
! 395: }
! 396:
! 397: 1;
! 398:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to ltipassback.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / lti