Diff for /loncom/lti/ltiutils.pm between versions 1.12 and 1.19

version 1.12, 2018/05/30 17:22:30 version 1.19, 2023/06/02 01:20:28
Line 31  package LONCAPA::ltiutils; Line 31  package LONCAPA::ltiutils;
 use strict;  use strict;
 use Net::OAuth;  use Net::OAuth;
 use Digest::SHA;  use Digest::SHA;
   use Digest::MD5 qw(md5_hex);
   use Encode;
 use UUID::Tiny ':std';  use UUID::Tiny ':std';
 use Apache::lonnet;  use Apache::lonnet;
 use Apache::loncommon;  use Apache::loncommon;
Line 40  use Apache::lonenc(); Line 42  use Apache::lonenc();
 use Apache::longroup();  use Apache::longroup();
 use Apache::lonlocal;  use Apache::lonlocal;
 use Math::Round();  use Math::Round();
   use LONCAPA::Lond;
 use LONCAPA qw(:DEFAULT :match);  use LONCAPA qw(:DEFAULT :match);
   
 #  #
Line 208  sub get_tool_secret { Line 211  sub get_tool_secret {
         %{$toolsettings}=&Apache::lonnet::dump('exttool_'.$marker,$cdom,$cnum);          %{$toolsettings}=&Apache::lonnet::dump('exttool_'.$marker,$cdom,$cnum);
         if ($toolsettings->{'id'}) {          if ($toolsettings->{'id'}) {
             my $idx = $toolsettings->{'id'};              my $idx = $toolsettings->{'id'};
             my %lti = &Apache::lonnet::get_domain_lti($cdom,'consumer');              my ($crsdef,$ltinum);
             if (ref($lti{$idx}) eq 'HASH') {              if ($idx =~ /^c(\d+)$/) {
                 %{$ltitools} = %{$lti{$idx}};                  $ltinum = $1;
                 if ($ltitools->{'key'} eq $key) {                  $crsdef = 1;
                     $consumer_secret = $ltitools->{'secret'};                  my %crslti = &Apache::lonnet::get_course_lti($cnum,$cdom,'consumer');
                   if (ref($crslti{$ltinum}) eq 'HASH') {
                       %{$ltitools} = %{$crslti{$ltinum}};
                   } else {
                       undef($ltinum);
                   }
               } elsif ($idx =~ /^\d+$/) {
                   my %lti = &Apache::lonnet::get_domain_lti($cdom,'consumer');
                   if (ref($lti{$idx}) eq 'HASH') {
                       %{$ltitools} = %{$lti{$idx}};
                       $ltinum = $idx;
                   }
               }
               if ($ltinum ne '') {
                   my $loncaparev = &Apache::lonnet::get_server_loncaparev($cdom);
                   my $keynum = $ltitools->{'cipher'};
                   my ($poss_key,$poss_secret) =
                       &LONCAPA::Lond::get_lti_credentials($cdom,$cnum,$crsdef,'tools',$ltinum,$keynum,$loncaparev);
                   if ($poss_key eq $key) {
                       $consumer_secret = $poss_secret;
                     $nonce_lifetime = $ltitools->{'lifetime'};                      $nonce_lifetime = $ltitools->{'lifetime'};
                 } else {                  } else {
                     $errors->{11} = 1;                      $errors->{11} = 1;
Line 240  sub get_tool_secret { Line 262  sub get_tool_secret {
 # secret for the specific LTI Provider.  # secret for the specific LTI Provider.
 #  #
   
   # FIXME Move to Lond.pm and perform on course's homeserver
   
 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 276  sub verify_lis_item { Line 314  sub verify_lis_item {
     my ($has_action, $valid_for);      my ($has_action, $valid_for);
     if ($context eq 'grade') {      if ($context eq 'grade') {
         $has_action = $ltitools->{'passback'};          $has_action = $ltitools->{'passback'};
         $valid_for = $ltitools->{'passbackvalid'}          $valid_for = $ltitools->{'passbackvalid'} * 86400; # convert days to seconds
     } elsif ($context eq 'roster') {      } elsif ($context eq 'roster') {
         $has_action = $ltitools->{'roster'};          $has_action = $ltitools->{'roster'};
         $valid_for = $ltitools->{'rostervalid'};          $valid_for = $ltitools->{'rostervalid'};
Line 296  sub verify_lis_item { Line 334  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 342  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 325  sub verify_lis_item { Line 363  sub verify_lis_item {
 #   # 
   
 sub sign_params {  sub sign_params {
     my ($url,$key,$secret,$sigmethod,$paramsref) = @_;      my ($url,$key,$secret,$paramsref,$sigmethod,$type,$callback,$post) = @_;
     return unless (ref($paramsref) eq 'HASH');      return unless (ref($paramsref) eq 'HASH');
     if ($sigmethod eq '') {      if ($sigmethod eq '') {
         $sigmethod = 'HMAC-SHA1';          $sigmethod = 'HMAC-SHA1';
     }      }
       if ($type eq '') {
           $type = 'request token';
       }
       if ($callback eq '') {
           $callback = 'about:blank',
       }
     srand( time() ^ ($$ + ($$ << 15))  ); # Seed rand.      srand( time() ^ ($$ + ($$ << 15))  ); # Seed rand.
     my $nonce = Digest::SHA::sha1_hex(sprintf("%06x%06x",rand(0xfffff0),rand(0xfffff0)));      my $nonce = Digest::SHA::sha1_hex(sprintf("%06x%06x",rand(0xfffff0),rand(0xfffff0)));
     my $request = Net::OAuth->request("request token")->new(      my $request = Net::OAuth->request($type)->new(
             consumer_key => $key,              consumer_key => $key,
             consumer_secret => $secret,              consumer_secret => $secret,
             request_url => $url,              request_url => $url,
Line 340  sub sign_params { Line 384  sub sign_params {
             signature_method => $sigmethod,              signature_method => $sigmethod,
             timestamp => time,              timestamp => time,
             nonce => $nonce,              nonce => $nonce,
             callback => 'about:blank',              callback => $callback,
             extra_params => $paramsref,              extra_params => $paramsref,
             version      => '1.0',              version      => '1.0',
             );              );
     $request->sign;      $request->sign();
     return $request->to_hash();      if ($post) {
           return $request->to_post_body();
       } else {
           return $request->to_hash();
       }
 }  }
   
 #  #
Line 382  sub set_service_secret { Line 430  sub set_service_secret {
     my $warning;      my $warning;
     my ($needsnew,$oldsecret,$lifetime);      my ($needsnew,$oldsecret,$lifetime);
     if ($name eq 'grade') {      if ($name eq 'grade') {
         $lifetime = $ltitools->{'passbackvalid'}          $lifetime = $ltitools->{'passbackvalid'} * 86400; # convert days to seconds
     } elsif ($name eq 'roster') {      } elsif ($name eq 'roster') {
         $lifetime = $ltitools->{'rostervalid'};          $lifetime = $ltitools->{'rostervalid'};
     }      }
     if ($toolsettings->{$name} eq '') {      if ($toolsettings->{$name.'secret'} eq '') {
         $needsnew = 1;          $needsnew = 1;
     } elsif (($toolsettings->{$name.'date'} + $lifetime) < $now) {      } elsif (($toolsettings->{$name.'secretdate'} + $lifetime) < $now) {
         $oldsecret = $toolsettings->{$name.'secret'};          $oldsecret = $toolsettings->{$name.'secret'};
         $needsnew = 1;          $needsnew = 1;
     }      }
Line 466  sub release_tool_lock { Line 514  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 488  sub lti_provider_scope { Line 577  sub lti_provider_scope {
             $scope = 'map';              $scope = 'map';
             $realuri = $tail;              $realuri = $tail;
         } else {          } else {
             my ($map,$resid,$url) = &Apache::lonnet::decode_symb($tail);              my $symb = $tail;
               $symb =~ s{^/}{};
               my ($map,$resid,$url) = &Apache::lonnet::decode_symb($symb);
             $realuri = &Apache::lonnet::clutter($url);              $realuri = &Apache::lonnet::clutter($url);
             if ($url =~ /\.sequence$/) {              if ($url =~ /\.sequence$/) {
                 $scope = 'map';                  $scope = 'map';
             } else {              } else {
                 $scope = 'resource';                  $scope = 'resource';
                 $realuri .= '?symb='.$tail;                  $realuri .= '?symb='.$symb;
                 $passkey = $tail;                  $passkey = $symb;
                 if ($getunenc) {                  if ($getunenc) {
                     $unencsymb = $tail;                      $unencsymb = $symb;
                 }                  }
             }              }
         }          }
Line 507  sub lti_provider_scope { Line 598  sub lti_provider_scope {
             $scope = 'map';              $scope = 'map';
             $realuri = $tail;              $realuri = $tail;
         } else {          } else {
             my ($map,$resid,$url) = &Apache::lonnet::decode_symb($tail);              my $symb = $tail;
               $symb =~ s{^/?res/}{};
               my ($map,$resid,$url) = &Apache::lonnet::decode_symb($symb);
             $realuri = &Apache::lonnet::clutter($url);              $realuri = &Apache::lonnet::clutter($url);
             if ($url =~ /\.sequence$/) {              if ($url =~ /\.sequence$/) {
                 $scope = 'map';                  $scope = 'map';
             } else {              } else {
                 $scope = 'resource';                  $scope = 'resource';
                 $realuri .= '?symb='.$tail;                  $realuri .= '?symb='.$symb;
                 $passkey = $tail;                  $passkey = $symb;
                 if ($getunenc) {                  if ($getunenc) {
                     $unencsymb = $tail;                      $unencsymb = $symb;
                 }                  }
             }              }
         }          }
Line 562  sub lti_provider_scope { Line 655  sub lti_provider_scope {
     } elsif (($tail =~ m{^/$cdom/$cnum$}) || ($tail eq '')) {      } elsif (($tail =~ m{^/$cdom/$cnum$}) || ($tail eq '')) {
         $scope = 'course';          $scope = 'course';
         $realuri = '/adm/navmaps';          $realuri = '/adm/navmaps';
         $passkey = $tail;          $passkey = '';
     }      }
     if ($scope eq 'map') {      if ($scope eq 'map') {
         $passkey = $realuri;          $passkey = $realuri;
Line 582  sub lti_provider_scope { Line 675  sub lti_provider_scope {
 #  #
   
 sub get_roster {  sub get_roster {
     my ($id,$url,$ckey,$secret) = @_;      my ($cdom,$cnum,$ltinum,$keynum,$id,$url) = @_;
     my %ltiparams = (      my %ltiparams = (
         lti_version                => 'LTI-1p0',          lti_version                => 'LTI-1p0',
         lti_message_type           => 'basic-lis-readmembershipsforcontext',          lti_message_type           => 'basic-lis-readmembershipsforcontext',
         ext_ims_lis_memberships_id => $id,          ext_ims_lis_memberships_id => $id,
     );      );
     my $hashref = &sign_params($url,$ckey,$secret,\%ltiparams);      my %info = ();
     if (ref($hashref) eq 'HASH') {      my ($status,$hashref) =
           &Apache::lonnet::sign_lti($cdom,$cnum,'','lti','roster',$url,$ltinum,$keynum,\%ltiparams,\%info);
       if (($status eq 'ok') && (ref($hashref) eq 'HASH')) {
         my $request=new HTTP::Request('POST',$url);          my $request=new HTTP::Request('POST',$url);
         $request->content(join('&',map {          $request->content(join('&',map {
                           my $name = escape($_);                            my $name = escape($_);
Line 647  sub get_roster { Line 742  sub get_roster {
 #  #
   
 sub send_grade {  sub send_grade {
     my ($id,$url,$ckey,$secret,$scoretype,$total,$possible) = @_;      my ($cdom,$cnum,$crsdef,$type,$ltinum,$keynum,$id,$url,$scoretype,$sigmethod,$msgformat,$total,$possible) = @_;
     my $score;      my $score;
     if ($possible > 0) {      if ($possible > 0) {
         if ($scoretype eq 'ratio') {          if ($scoretype eq 'ratio') {
Line 660  sub send_grade { Line 755  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',      my $request;
         sourcedid                     => $id,      if ($msgformat eq '1.0') {
         result_resultscore_textstring => $score,          my $date = &Apache::loncommon::utc_string(time);
         result_resultscore_language   => 'en-US',          my %ltiparams = (
         result_resultvaluesourcedid   => $scoretype,              lti_version                   => 'LTI-1p0',
         result_statusofresult         => 'final',              lti_message_type              => 'basic-lis-updateresult',
         result_date                   => $date,              sourcedid                     => $id,
     );              result_resultscore_textstring => $score,
     my $hashref = &sign_params($url,$ckey,$secret,\%ltiparams);              result_resultscore_language   => 'en-US',
     if (ref($hashref) eq 'HASH') {              result_resultvaluesourcedid   => $scoretype,
         my $request=new HTTP::Request('POST',$url);              result_statusofresult         => 'final',
         $request->content(join('&',map {              result_date                   => $date,
                           my $name = escape($_);          );
                           "$name=" . ( ref($hashref->{$_}) eq 'ARRAY'          my %info = (
                           ? join("&$name=", map {escape($_) } @{$hashref->{$_}})                          method => $sigmethod,
                           : &escape($hashref->{$_}) );                     ); 
         } keys(%{$hashref})));          my ($status,$hashref) =
         my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10);              &Apache::lonnet::sign_lti($cdom,$cnum,$crsdef,$type,'grade',$url,$ltinum,$keynum,
         my $message=$response->status_line;                                        \%ltiparams,\%info);   
           if (($status eq 'ok') && (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})));
   #FIXME Need to handle case where passback failed.
           }
       } else {
           srand( time() ^ ($$ + ($$ << 15))  ); # Seed rand.
           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 $reqmethod = 'POST';
           my %info = (
                         body_hash => $bodyhash,
                         method => $sigmethod,
                         reqtype => 'consumer',
                         reqmethod => $reqmethod,
                         respfmt => 'to_authorization_header',
                      );
           my %params;
           my ($status,$authheader) =
               &Apache::lonnet::sign_lti($cdom,$cnum,$crsdef,$type,'grade',$url,$ltinum,$keynum,\%params,\%info);
           if (($status eq 'ok') && ($authheader ne '')) {
               $request = HTTP::Request->new(
                      $reqmethod,
                      $url,
                      [
                 'Authorization' => $authheader,
                 '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.  #FIXME Handle case where pass back of score to LTI Consumer failed.
           }
       }
   }
   
   sub setup_logout_callback {
       my ($cdom,$cnum,$crstool,$idx,$keynum,$uname,$udom,$server,$service_url,$idsdir,$protocol,$hostname) = @_;
       if ($service_url =~ m{^https?://[^/]+/}) {
           my $digest_user = &Encode::decode('UTF-8',$uname.':'.$udom);
           my $loginfile = &Digest::SHA::sha1_hex($digest_user).&md5_hex(&md5_hex(time.{}.rand().$$));
           if ((-d $idsdir) && (open(my $fh,'>',"$idsdir/$loginfile"))) {
               print $fh "$uname,$udom,$server\n";
               close($fh);
               my $callback = 'http://'.$hostname.'/adm/service/logout/'.$loginfile;
               my %ltiparams = (
                   callback   => $callback,
               );
               my %info = (
                   respfmt => 'to_post_body',
               );
               my ($status,$post) = 
                   &Apache::lonnet::sign_lti($cdom,$cnum,$crstool,'lti','logout',$service_url,$idx,
                                             $keynum,\%ltiparams,\%info);
               if (($status eq 'ok') && ($post ne '')) {
                   my $request=new HTTP::Request('POST',$service_url);
                   $request->content($post);
                   my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10);
               }
           }
     }      }
       return;
 }  }
   
 #  #
Line 911  sub enrolluser { Line 1102  sub enrolluser {
   
 sub batchaddroster {  sub batchaddroster {
     my ($item) = @_;      my ($item) = @_;
     return unless(ref($item) eq 'HASH');      return unless((ref($item) eq 'HASH') &&
     return unless (ref($item->{'ltiref'}) eq 'HASH');                    (ref($item->{'ltiref'}) eq 'HASH'));
     my ($cdom,$cnum) = split(/_/,$item->{'cid'});      my ($cdom,$cnum) = split(/_/,$item->{'cid'});
       return if (($cdom eq '') || ($cnum eq ''));
     my $udom = $cdom;      my $udom = $cdom;
     my $id = $item->{'id'};      my $id = $item->{'id'};
     my $url = $item->{'url'};      my $url = $item->{'url'};
       my $ltinum = $item->{'lti'};
       my $keynum = $item->{'ltiref'}->{'cipher'};
     my @intdoms;      my @intdoms;
     my $intdomsref = $item->{'intdoms'};      my $intdomsref = $item->{'intdoms'};
     if (ref($intdomsref) eq 'ARRAY') {      if (ref($intdomsref) eq 'ARRAY') {
         @intdoms = @{$intdomsref};          @intdoms = @{$intdomsref};
     }      }
     my $uriscope = $item->{'uriscope'};      my $uriscope = $item->{'uriscope'};
     my $ckey = $item->{'ltiref'}->{'key'};  
     my $secret = $item->{'ltiref'}->{'secret'};  
     my $section = $item->{'ltiref'}->{'section'};      my $section = $item->{'ltiref'}->{'section'};
     $section =~ s/\W//g;      $section =~ s/\W//g;
     if ($section eq 'none') {      if ($section eq 'none') {
Line 943  sub batchaddroster { Line 1135  sub batchaddroster {
     if (ref($item->{'possroles'}) eq 'ARRAY') {      if (ref($item->{'possroles'}) eq 'ARRAY') {
         @possroles = @{$item->{'possroles'}};          @possroles = @{$item->{'possroles'}};
     }      }
     if (($ckey ne '') && ($secret ne '') && ($id ne '') && ($url ne '')) {      if (($id ne '') && ($url ne '')) {
         my %data = &get_roster($id,$url,$ckey,$secret);          my %data = &get_roster($cdom,$cnum,$ltinum,$keynum,$id,$url);
         if (keys(%data) > 0) {          if (keys(%data) > 0) {
             my (%rulematch,%inst_results,%curr_rules,%got_rules,%alerts,%info);              my (%rulematch,%inst_results,%curr_rules,%got_rules,%alerts,%info);
             my %coursehash = &Apache::lonnet::coursedescription($cdom.'_'.$cnum);              my %coursehash = &Apache::lonnet::coursedescription($cdom.'_'.$cnum);

Removed from v.1.12  
changed lines
  Added in v.1.19


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