Return to ltipassback.pm CVS log

Up to [LON-CAPA] / loncom / lti

- Bug 6754 LON-CAPA as LTI Provider
  - Support requests to /adm/service/passback and /adm/service/roster in
    which OAuth data in request header.
  - Support LTI Basic Outcomes Service (1.1) in which grade (a decimal) is
    included in XML in the request body (with oauth_body_hash in the header).
  - LTI Provider domain configuration to set grade passback using either
    Outcomes Service (1.1) -- the default -- or Outcomes extension (1.0).

    1: # The LearningOnline Network with CAPA
    2: # LTI Consumer Module to receive grades passed back by Provider 
    3: #
    4: # $Id: ltipassback.pm,v 1.6 2018/08/14 21:42:36 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 URI::Escape;
   33: use Apache::Constants qw(:common :http);
   34: use Apache::lonnet;
   35: use Apache::loncommon;
   36: use Apache::lonacc;
   37: use LONCAPA::ltiutils;
   38: 
   39: sub handler {
   40:     my $r = shift;
   41:     my %errors;
   42:     my $params = {};
   43:     my ($oauthtype,$authheader,$xmlbody);
   44: #
   45: # Retrieve content type from headers
   46: #
   47:     my $content_type = $r->headers_in->get('Content-Type');
   48:     if ($content_type eq 'application/xml') {
   49:         $oauthtype = 'consumer';
   50: #
   51: # Retrieve OAuth data from Authorization header sent by LTI Provider
   52: #
   53:         $authheader = $r->headers_in->get('Authorization');
   54:         my ($authtype,$valuestr) = ($authheader =~ /^(OAuth)\s+(.+)$/i);
   55:         if (lc($authtype) eq 'oauth') {
   56:             foreach my $pair (split(/\s*,\s*/,$valuestr)) {
   57:                 my ($key,$value) = split(/=/,$pair);
   58:                 $value =~ s /(^"|"$)//g;
   59:                 $params->{$key} = URI::Escape::uri_unescape($value);
   60:             }
   61:         }
   62: #
   63: # Retrieve message body
   64: #
   65:         my $length = $r->headers_in->get('Content-length');
   66:         if ($length) {
   67:             $r->read($xmlbody,$length,0);
   68:             if ($xmlbody ne '') {
   69:                 my %grades = &LONCAPA::ltiutils::parse_grade_xml($xmlbody);
   70:                 foreach my $num (sort { $a <=> $b } (keys(%grades))) {
   71:                     if (ref($grades{$num}) eq 'HASH') {
   72:                         if (($grades{$num}{'sourcedid'} ne '') && ($grades{$num}{'score'} ne '')) {
   73:                             $params->{'sourcedid'} = $grades{$num}{'sourcedid'};
   74:                             $params->{'result_resultscore_textstring'} = $grades{$num}{'score'};
   75:                             $params->{'result_resultscore_language'} = $grades{$num}{'language'};
   76:                             $params->{'result_resultvaluesourcedid'} = 'decimal'; 
   77:                         }
   78:                     } 
   79:                 }
   80:             }
   81:         }
   82:     } else {
   83:         $oauthtype = 'request token';
   84: #
   85: # Retrieve data POSTed by LTI Provider
   86: #
   87:         &Apache::lonacc::get_posted_cgi($r);
   88:         foreach my $key (sort(keys(%env))) {
   89:             if ($key =~ /^form\.(.+)$/) {
   90:                 $params->{$1} = $env{$key};
   91:             }
   92:         }
   93:     }
   94: 
   95:     unless (keys(%{$params})) {
   96:         $errors{1} = 1; 
   97:         &invalid_request($r,$params,\%errors);
   98:         return OK;
   99:     }
  100: 
  101:     unless ($params->{'oauth_consumer_key'} &&
  102:             $params->{'oauth_nonce'} &&
  103:             $params->{'oauth_timestamp'} &&
  104:             $params->{'oauth_version'} &&
  105:             $params->{'oauth_signature'} &&
  106:             $params->{'oauth_signature_method'}) {
  107:         $errors{2} = 1; 
  108:         &invalid_request($r,$params,\%errors);
  109:         return OK;
  110:     }
  111: 
  112: #
  113: # Retrieve the signature, digested symb, digested user, and LON-CAPA 
  114: # courseID from the sourcedid in the POSTed data
  115: #
  116:     unless ($params->{'sourcedid'}) {
  117:         $errors{3} = 1; 
  118:         &invalid_request($r,$params,\%errors);
  119:         return OK;
  120:     }
  121: 
  122:     my ($resultsig,$digsymb,$diguser,$cid) = split(/\Q:::\E/,$params->{'sourcedid'});
  123:     unless ($resultsig && $digsymb && $diguser && $cid) {
  124:         $errors{4} = 1; 
  125:         &invalid_request($r,$params,\%errors);
  126:         return OK;
  127:     }
  128: 
  129:     my ($cdom,$cnum,$marker,$symb,$uname,$udom);
  130: 
  131: #
  132: # Determine the domain and the courseID of the LON-CAPA course to which the
  133: # launch of LON-CAPA should provide access.
  134: #
  135:     ($cdom,$cnum) = &LONCAPA::ltiutils::get_loncapa_course($r->dir_config('lonHostID'),
  136:                                                            $cid,\%errors);  
  137:     unless ($cdom && $cnum) {
  138:         &invalid_request($r,$params,\%errors);
  139:         return OK;
  140:     }
  141: 
  142: #
  143: # Use the digested symb to lookup the real symb in exttools.db
  144: #
  145: 
  146:     ($marker,$symb,$uname,$udom) = 
  147:         &LONCAPA::ltiutils::get_tool_instance($cdom,$cnum,$digsymb,$diguser,\%errors);
  148: 
  149:     unless ($marker) {
  150:         &invalid_request($r,$params,\%errors);
  151:         return OK;
  152:     }
  153: 
  154: #
  155: # Retrieve the Consumer key and Consumer secret from the domain configuration
  156: # for the Tool Provider ID stored in the exttool_$marker.db
  157: #
  158: 
  159:     my (%toolsettings,%ltitools);
  160:     my ($consumer_secret,$nonce_lifetime) = 
  161:         &LONCAPA::ltiutils::get_tool_secret($params->{'oauth_consumer_key'},
  162:                                             $marker,$symb,$cdom,$cnum,
  163:                                             \%toolsettings,\%ltitools,\%errors);
  164: 
  165:     if (keys(%errors) > 0) {
  166:         &invalid_request($r,$params,\%errors);
  167:         return OK;
  168:     }
  169: 
  170: #
  171: # Verify the signed request using the consumer_key and 
  172: # secret for the specific LTI Provider.
  173: #
  174: 
  175:     my $protocol = 'http';
  176:     if ($ENV{'SERVER_PORT'} == 443) {
  177:         $protocol = 'https';
  178:     }
  179: 
  180:     unless (LONCAPA::ltiutils::verify_request($oauthtype,$protocol,$r->hostname,$r->uri,
  181:                                               $r->method,$consumer_secret,$params,
  182:                                               $authheader,\%errors)) {
  183:         &invalid_request($r,$params,\%errors);
  184:         return OK;
  185:     }
  186: 
  187: #
  188: # Verify XML in request body has not been tampered with
  189: #
  190: 
  191:     my $bodyhash = Digest::SHA::sha1_base64($xmlbody);
  192:     while (length($bodyhash) % 4) {
  193:         $bodyhash .= '=';
  194:     }
  195:     unless ($bodyhash eq $params->{oauth_body_hash}) {
  196:         $errors{16} = 1;
  197:         &invalid_request($r,$params,\%errors);
  198:         return OK;
  199:     }
  200: 
  201: #
  202: # Determine if nonce in POSTed data has expired.
  203: # If unexpired, confirm it has not already been used.
  204: #
  205: 
  206:     unless (&LONCAPA::ltiutils::check_nonce($params->{'oauth_nonce'},$params->{'oauth_timestamp'},
  207:                                             $ltitools{'lifetime'},$cdom,$r->dir_config('lonLTIDir'))) {
  208:         $errors{17} = 1;
  209:         &invalid_request($r,$params,\%errors);
  210:         return OK;
  211:     }
  212: 
  213: #
  214: # Verify that the sourcedid has not been tampered with,
  215: # and the gradesecret used to create it is still valid. 
  216: # 
  217: 
  218:     unless (&LONCAPA::ltiutils::verify_lis_item($resultsig,'grade',$digsymb,$diguser,$cdom,
  219:                                                 $cnum,\%toolsettings,\%ltitools,\%errors)) {
  220:         &invalid_request($r,$params,\%errors);
  221:         return OK;
  222:     }
  223: 
  224: #
  225: # Does the user have an active role in the course which maps to one of
  226: # the supported LTI roles
  227: #
  228: 
  229:     if (($uname ne '') && ($udom ne '')) {
  230:         my %maproles;
  231:         if (ref($ltitools{'roles'}) eq 'HASH') {
  232:             %maproles = %{$ltitools{'roles'}};
  233:         }
  234:         unless (keys(%maproles)) {
  235:             $errors{22} = 1;
  236:             &invalid_request($r,$params,\%errors);
  237:             return OK;
  238:         }
  239:         my ($crstype,$hasrole);
  240:         my @allroles = &Apache::lonuserutils::roles_by_context('course',0,$crstype);
  241:         my (%availableroles,$coursepersonnel,$includestudents,%users);
  242:         foreach my $role (@allroles) {
  243:             if (exists($maproles{$role})) {
  244:                 $availableroles{$role} = 1;
  245:                 if ($role eq 'st') {
  246:                     $includestudents = 1;
  247:                 } else {
  248:                     $coursepersonnel = 1;
  249:                 }
  250:             }
  251:         }
  252:         if (keys(%availableroles)) {
  253:             my $courseurl = "/$cdom/$cnum";
  254:             my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname,$courseurl);
  255:             if (keys(%roleshash)) {
  256:                 my $now = time;
  257:                 foreach my $key (keys(%roleshash)) {
  258:                     if ($key =~ m{^\Q$courseurl\E(|/\w+)_(\w+)$}) {
  259:                         my ($secgroup,$rolecode) = ($1,$2);
  260:                         next if ($rolecode eq 'gr');
  261:                         next unless ($availableroles{$rolecode});
  262:                         my ($dummy,$end,$start)=split(/\_/,$roleshash{$key});
  263:                         next if (defined($end) && $end && ($now > $end));
  264:                         next if (defined($start) && $start && ($now < $start));
  265:                         $hasrole = 1;
  266:                         last;
  267:                     }
  268:                 }
  269:             }
  270:         }
  271:         unless ($hasrole) {
  272:             $errors{23} = 1;
  273:             &invalid_request($r,$params,\%errors);
  274:             return OK;
  275:         }
  276:     } else {
  277:         $errors{24} = 1;
  278:         &invalid_request($r,$params,\%errors);
  279:         return OK;
  280:     }
  281: 
  282: #
  283: # Store result if one was sent in a valid format. 
  284: #
  285: 
  286:     my ($result,$resulttype,$lang,$pcf);
  287:     if (exists($params->{'result_resultvaluesourcedid'})) {
  288:         $resulttype = $params->{'result_resultvaluesourcedid'};
  289:         $resulttype =~ s/(^\s+|\s+)$//g;
  290:     } else {
  291:         $resulttype = 'decimal';
  292:     }
  293:     $result = $params->{'result_resultscore_textstring'};
  294:     $result =~ s/(^\s+|\s+)$//g;
  295:     my $posslang = $params->{'result_resultscore_language'};
  296:     $posslang =~ s/(^\s+|\s+)$//g;
  297:     if ($posslang =~ /^\w+(|\-\w+(|\-w+))$/) {
  298:         $lang = $posslang;
  299:     }
  300:     if (($resulttype eq 'ratio') || ($resulttype eq 'decimal') || ($resulttype eq 'percentage')) {
  301:         if ($resulttype eq 'ratio') {
  302:             my ($numerator,$denominator) = split(/\s*\/\s*/,$result,2);
  303:             $numerator =~ s/(^\s+|\s+)$//g;
  304:             $denominator =~ s/(^\s+|\s+)$//g;
  305:             if (($numerator =~ /^\d+$/) && ($denominator =~ /^\d+$/) && ($denominator !=0)) {
  306:                 eval {
  307:                          $pcf = $numerator/$denominator;
  308:                      };
  309:             }
  310:             if ($@) {
  311:                 $errors{24} = 1;
  312:                 &invalid_request($r,$params,\%errors);
  313:                 return OK;
  314:             }
  315:         } elsif ($resulttype eq 'decimal') {
  316:             if (($result ne '') && ($result =~ /^\d*\.?\d*$/)) {
  317:                 if ($result eq '.') {
  318:                     $result = 0;
  319:                 }
  320:                 if (($result >= 0) && ($result <= 1)) {
  321:                     $pcf = $result;
  322:                 }
  323:             }
  324:         } elsif ($resulttype eq 'percentage') {
  325:             if ($result =~ /^(\d+)\s*\%?$/) {
  326:                 my $percent = $1;
  327:                 if (($percent >= 0) && ($percent <= 100)) {
  328:                     $pcf = $percent/100.0;
  329:                 }
  330:             }
  331:         }
  332:         if ($pcf ne '') {
  333:             my %newrecord=();
  334:             my $reckey = 'resource.0.solved'; 
  335:             my %record = &Apache::lonnet::restore($symb,$cdom.'_'.$cnum,$udom,$uname);
  336:             my $tries = 0;
  337:             if ($record{'resource.0.tries'} =~ /^\d$/) {
  338:                 $tries = $record{'resource.0.tries'};
  339:             }
  340:             if ($record{'resource.0.awarded'} ne $pcf) {
  341:                 $newrecord{'resource.0.awarded'}  = $pcf;
  342:             }
  343:             if ($pcf == 0) {
  344:                 if ($record{$reckey} ne 'incorrect_by_passback') {
  345:                     $newrecord{$reckey} = 'incorrect_by_passback';
  346:                 }
  347:             } else {
  348:                 if ($record{$reckey} ne 'correct_by_passback') {
  349:                     $newrecord{$reckey} = 'correct_by_passback';
  350:                 }
  351:             }
  352:             if (%newrecord) {
  353:                 $newrecord{'resource.0.tries'} = 1 + $tries;
  354:                 $env{'request.course.id'} = $cdom.'_'.$cnum;
  355:                 my $result = &Apache::lonnet::cstore(\%newrecord,$symb,$cdom.'_'.$cnum,
  356:                                                      $udom,$uname);
  357:                 delete($env{'request.course.id'});
  358:                 if (($result eq 'ok') || ($result eq 'con_delayed')) {
  359:                     &success($r,$params->{'sourcedid'},$resulttype,$result,$lang);
  360:                 } else {
  361:                     $errors{25} = 1;
  362:                     &invalid_request($r,$params,\%errors);
  363:                 }
  364:             } else {
  365:                 &success($r,$params->{'sourcedid'},$resulttype,$result,$lang);
  366:             }
  367:         } else {
  368:             $errors{26} = 1;
  369:             &invalid_request($r,$params,\%errors);
  370:         }
  371:     } else {
  372:         $errors{27} = 1;
  373:         &invalid_request($r,$params,\%errors);
  374:     }
  375:     return OK;
  376: }
  377: 
  378: sub success {
  379:     my ($r,$sourcedid,$scoretype,$score,$lang) = @_;
  380:     my $date = &Apache::loncommon::utc_string(time); 
  381:     &Apache::loncommon::content_type($r,'text/xml');
  382:     $r->send_http_header;
  383:     if ($r->header_only) {
  384:         return;
  385:     }
  386:     $r->print(<<"END");
  387: <?xml version="1.0" encoding="UTF-8" ?>
  388: <message_response>
  389:   <lti_message_type>basic-lis-updateresult</lti_message_type>
  390:   <statusinfo>
  391:     <codemajor>Success</codemajor>
  392:     <severity>Status</severity>
  393:     <codeminor>fullsuccess</codeminor>
  394:     <description>Grade updated</description>
  395:   </statusinfo>
  396:   <result>
  397:     <sourcedid>$sourcedid</sourcedid>
  398:     <date>$date</date>
  399:     <resultscore>
  400:       <resultvaluesourcedid>$scoretype</resultvaluesourcedid>
  401:       <textstring>$score</textstring>
  402:       <language>$lang</language>
  403:     </resultscore>
  404:   </result>
  405: </message_response>
  406: END
  407:     return;
  408: }
  409: 
  410: sub invalid_request {
  411:     my ($r,$params,$errors) = @_;
  412:     my $date = &Apache::loncommon::utc_string(time);
  413:     my ($scoretype,$score,$lang);
  414:     if (ref($params) eq 'HASH') {
  415:         if ($params->{'result_resultvaluesourcedid'} =~ /^\s*(decimal|percentage|ratio)\s*$/) {
  416:             $scoretype = $1;
  417:         }
  418:         if ($scoretype eq 'decimal') {
  419:             if ($params->{'result_resultscore_textstring'} =~ /^\s*(\d*\.?\d*)\s*$/) {
  420:                 $score = $1;
  421:             }
  422:         } elsif ($scoretype eq 'ratio') {
  423:             if ($params->{'result_resultscore_textstring'} =~ m{^\s*(\d+)\s*/\s*(\d+)\s*$}) {
  424:                 $score = $1.'/'.$2;
  425:             }
  426:         } elsif ($scoretype eq 'percentage') {
  427:             if ($params->{'result_resultscore_textstring'} =~ /^\s*(\d+)\s*(\%?)\s*$/) {
  428:                 $score = $1.$2;
  429:             }
  430:         }
  431:         my $posslang = $params->{'result_resultscore_language'};
  432:         $posslang =~ s/(^\s+|\s+)$//g; 
  433:         if ($posslang =~ /^\w+(|\-\w+(|\-w+))$/) {
  434:             $lang = $posslang;
  435:         }
  436:     } 
  437:     my $errormsg;
  438:     if (ref($errors) eq 'HASH') {
  439:         $errormsg = join(',',keys(%{$errors}));
  440:     }
  441:     &Apache::loncommon::content_type($r,'text/xml');
  442:     $r->send_http_header;
  443:     if ($r->header_only) {
  444:         return;
  445:     }
  446:     $r->print(<<"END");
  447: <message_response>
  448:   <lti_message_type>basic-lis-updateresult</lti_message_type>
  449:   <statusinfo>
  450:      <codemajor>Failure</codemajor>
  451:      <severity>Error</severity>
  452:      <codeminor>$errormsg</codeminor>
  453:   </statusinfo>
  454:   <result>
  455:     <sourcedid>$params->{'sourcedid'}</sourcedid>
  456:     <statusofresult>interim</statusofresult>
  457:     <date>$date</date>
  458:     <resultscore>
  459:       <resultvaluesourcedid>$scoretype</resultvaluesourcedid>
  460:       <textstring>$score</textstring>
  461:       <language>$lang</language>
  462:     </resultscore>
  463:   </result>
  464: </message_response>
  465: END
  466:     return;
  467: }
  468: 
  469: 1;
  470: