[BACK]Return to ltiutils.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / lti

Diff for /loncom/lti/ltiutils.pm between versions 1.14 and 1.15

version 1.14, 2018/08/14 17:24:21 version 1.15, 2018/08/14 21:42:36
Line 241  sub get_tool_secret { Line 241  sub get_tool_secret {
 #  #
   
 sub verify_request {  sub verify_request {
     my ($params,$protocol,$hostname,$requri,$reqmethod,$consumer_secret,$errors) = @_;      my ($oauthtype,$protocol,$hostname,$requri,$reqmethod,$consumer_secret,$params,
     return unless (ref($errors) eq 'HASH');          $authheaders,$errors) = @_;
     my $request = Net::OAuth->request('request token')->from_hash($params,      unless (ref($errors) eq 'HASH') {
                                        request_url => $protocol.'://'.$hostname.$requri,          $errors->{15} = 1;
                                        request_method => $reqmethod,          return;
                                        consumer_secret => $consumer_secret,);      }
       my $request;
       if ($oauthtype eq 'consumer') {
           my $oauthreq = Net::OAuth->request('consumer');
           $oauthreq->add_required_message_params('body_hash');
           $request = $oauthreq->from_authorization_header($authheaders,
                                     request_url => $protocol.'://'.$hostname.$requri,
                                     request_method => $reqmethod,
                                     consumer_secret => $consumer_secret,);
       } else {
           $request = Net::OAuth->request('request token')->from_hash($params,
                                     request_url => $protocol.'://'.$hostname.$requri,
                                     request_method => $reqmethod,
                                     consumer_secret => $consumer_secret,);
       }
     unless ($request->verify()) {      unless ($request->verify()) {
         $errors->{15} = 1;          $errors->{15} = 1;
         return;          return;
Line 296  sub verify_lis_item { Line 310  sub verify_lis_item {
                 if ($expected_sig eq $sigrec) {                  if ($expected_sig eq $sigrec) {
                     return 1;                      return 1;
                 } else {                  } else {
                     $errors->{17} = 1;                      $errors->{18} = 1;
                 }                  }
             } elsif ($context eq 'roster') {              } elsif ($context eq 'roster') {
                 my $uniqid = $digsymb.':::'.$cdom.'_'.$cnum;                  my $uniqid = $digsymb.':::'.$cdom.'_'.$cnum;
Line 304  sub verify_lis_item { Line 318  sub verify_lis_item {
                 if ($expected_sig eq $sigrec) {                  if ($expected_sig eq $sigrec) {
                     return 1;                      return 1;
                 } else {                  } else {
                     $errors->{18} = 1;                      $errors->{19} = 1;
                 }                  }
             }              }
         } else {          } else {
             $errors->{19} = 1;              $errors->{20} = 1;
         }          }
     } else {      } else {
         $errors->{20} = 1;          $errors->{21} = 1;
     }      }
     return;      return;
 }  }
Line 344  sub sign_params { Line 358  sub sign_params {
             extra_params => $paramsref,              extra_params => $paramsref,
             version      => '1.0',              version      => '1.0',
             );              );
     $request->sign;      $request->sign();
     return $request->to_hash();      return $request->to_hash();
 }  }
   
Line 466  sub release_tool_lock { Line 480  sub release_tool_lock {
 }  }
   
 #  #
   # LON-CAPA as LTI Consumer
   #
   # Parse XML containing grade data sent by an LTI Provider
   #
   
   sub parse_grade_xml {
       my ($xml) = @_;
       my %data = ();
       my $count = 0;
       my @state = ();
       my $p = HTML::Parser->new(
           xml_mode => 1,
           start_h =>
               [sub {
                   my ($tagname, $attr) = @_;
                   push(@state,$tagname);
                   if ("@state" eq "imsx_POXEnvelopeRequest imsx_POXBody replaceResultRequest resultRecord") {
                       $count ++;
                   }
               }, "tagname, attr"],
           text_h =>
               [sub {
                   my ($text) = @_;
                   if ("@state" eq "imsx_POXEnvelopeRequest imsx_POXBody replaceResultRequest resultRecord sourcedGUID sourcedId") {
                       $data{$count}{sourcedid} = $text;
                   } elsif ("@state" eq "imsx_POXEnvelopeRequest imsx_POXBody replaceResultRequest resultRecord result resultScore textString") {                               
                       $data{$count}{score} = $text;
                   }
               }, "dtext"],
           end_h =>
               [sub {
                    my ($tagname) = @_;
                    pop @state;
                   }, "tagname"],
       );
       $p->parse($xml);
       $p->eof;
       return %data;
   }
   
   #
 # LON-CAPA as LTI Provider  # LON-CAPA as LTI Provider
 #  #
 # Use the part of the launch URL after /adm/lti to determine  # Use the part of the launch URL after /adm/lti to determine
Line 651  sub get_roster { Line 706  sub get_roster {
 #  #
   
 sub send_grade {  sub send_grade {
     my ($id,$url,$ckey,$secret,$scoretype,$total,$possible) = @_;      my ($id,$url,$ckey,$secret,$scoretype,$sigmethod,$msgformat,$total,$possible) = @_;
     my $score;      my $score;
     if ($possible > 0) {      if ($possible > 0) {
         if ($scoretype eq 'ratio') {          if ($scoretype eq 'ratio') {
Line 664  sub send_grade { Line 719  sub send_grade {
             $score = sprintf("%.2f",$score);              $score = sprintf("%.2f",$score);
         }          }
     }      }
     my $date = &Apache::loncommon::utc_string(time);      if ($sigmethod eq '') {
     my %ltiparams = (          $sigmethod = 'HMAC-SHA1';
         lti_version                   => 'LTI-1p0',  
         lti_message_type              => 'basic-lis-updateresult',  
         sourcedid                     => $id,  
         result_resultscore_textstring => $score,  
         result_resultscore_language   => 'en-US',  
         result_resultvaluesourcedid   => $scoretype,  
         result_statusofresult         => 'final',  
         result_date                   => $date,  
     );  
     my $hashref = &sign_params($url,$ckey,$secret,'',\%ltiparams);  
     if (ref($hashref) eq 'HASH') {  
         my $request=new HTTP::Request('POST',$url);  
         $request->content(join('&',map {  
                           my $name = escape($_);  
                           "$name=" . ( ref($hashref->{$_}) eq 'ARRAY'  
                           ? join("&$name=", map {escape($_) } @{$hashref->{$_}})  
                           : &escape($hashref->{$_}) );  
         } keys(%{$hashref})));  
         my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10);  
         my $message=$response->status_line;  
 #FIXME Handle case where pass back of score to LTI Consumer failed.  
     }      }
       my $request;
       if ($msgformat eq '1.0') {
           my $date = &Apache::loncommon::utc_string(time);
           my %ltiparams = (
               lti_version                   => 'LTI-1p0',
               lti_message_type              => 'basic-lis-updateresult',
               sourcedid                     => $id,
               result_resultscore_textstring => $score,
               result_resultscore_language   => 'en-US',
               result_resultvaluesourcedid   => $scoretype,
               result_statusofresult         => 'final',
               result_date                   => $date,
           );
           my $hashref = &sign_params($url,$ckey,$secret,$sigmethod,\%ltiparams);
           if (ref($hashref) eq 'HASH') {
               $request=new HTTP::Request('POST',$url);
               $request->content(join('&',map {
                                 my $name = escape($_);
                                 "$name=" . ( ref($hashref->{$_}) eq 'ARRAY'
                                 ? join("&$name=", map {escape($_) } @{$hashref->{$_}})
                                 : &escape($hashref->{$_}) );
                                 } keys(%{$hashref})));
           }
       } else {
           srand( time() ^ ($$ + ($$ << 15))  ); # Seed rand.
           my $nonce = Digest::SHA::sha1_hex(sprintf("%06x%06x",rand(0xfffff0),rand(0xfffff0)));
           my $uniqmsgid = int(rand(2**32));
           my $gradexml = <<END;
   <?xml version = "1.0" encoding = "UTF-8"?>
   <imsx_POXEnvelopeRequest xmlns = "http://www.imsglobal.org/services/ltiv1p1/xsd/imsoms_v1p0">
     <imsx_POXHeader>
       <imsx_POXRequestHeaderInfo>
         <imsx_version>V1.0</imsx_version>
         <imsx_messageIdentifier>$uniqmsgid</imsx_messageIdentifier>
       </imsx_POXRequestHeaderInfo>
     </imsx_POXHeader>
     <imsx_POXBody>
       <replaceResultRequest>
         <resultRecord>
    <sourcedGUID>
     <sourcedId>$id</sourcedId>
    </sourcedGUID>
    <result>
     <resultScore>
       <language>en</language>
       <textString>$score</textString>
     </resultScore>
    </result>
         </resultRecord>
       </replaceResultRequest>
     </imsx_POXBody>
   </imsx_POXEnvelopeRequest>
   END
           chomp($gradexml);
           my $bodyhash = Digest::SHA::sha1_base64($gradexml);
           while (length($bodyhash) % 4) {
               $bodyhash .= '=';
           }
           my $gradereq = Net::OAuth->request('consumer')->new(
                              consumer_key => $ckey,
                              consumer_secret => $secret,
                              request_url => $url,
                              request_method => 'POST',
                              signature_method => $sigmethod,
                              timestamp => time(),
                              nonce => $nonce,
                              body_hash => $bodyhash,
           );
           $gradereq->sign();
           $request = HTTP::Request->new(
                  $gradereq->request_method,
                  $gradereq->request_url,
                  [
              'Authorization' => $gradereq->to_authorization_header,
              'Content-Type'  => 'application/xml',
                  ],
                  $gradexml,
           );
       }
       my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10);
       my $message=$response->status_line;
   #FIXME Handle case where pass back of score to LTI Consumer failed.
 }  }
   
 #  #
Removed from v.1.14  
changed lines
  Added in v.1.15

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>