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

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

version 1.17, 2019/07/18 18:28:46 version 1.19, 2023/06/02 01:20:28
Line 32  use strict; Line 32  use strict;
 use Net::OAuth;  use Net::OAuth;
 use Digest::SHA;  use Digest::SHA;
 use Digest::MD5 qw(md5_hex);  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 41  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 209  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 241  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 ($oauthtype,$protocol,$hostname,$requri,$reqmethod,$consumer_secret,$params,      my ($oauthtype,$protocol,$hostname,$requri,$reqmethod,$consumer_secret,$params,
         $authheaders,$errors) = @_;          $authheaders,$errors) = @_;
Line 652  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 717  sub get_roster { Line 742  sub get_roster {
 #  #
   
 sub send_grade {  sub send_grade {
     my ($id,$url,$ckey,$secret,$scoretype,$sigmethod,$msgformat,$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 746  sub send_grade { Line 771  sub send_grade {
             result_statusofresult         => 'final',              result_statusofresult         => 'final',
             result_date                   => $date,              result_date                   => $date,
         );          );
         my $hashref = &sign_params($url,$ckey,$secret,\%ltiparams,$sigmethod);          my %info = (
         if (ref($hashref) eq 'HASH') {                          method => $sigmethod,
                      ); 
           my ($status,$hashref) =
               &Apache::lonnet::sign_lti($cdom,$cnum,$crsdef,$type,'grade',$url,$ltinum,$keynum,
                                         \%ltiparams,\%info);   
           if (($status eq 'ok') && (ref($hashref) eq 'HASH')) {
             $request=new HTTP::Request('POST',$url);              $request=new HTTP::Request('POST',$url);
             $request->content(join('&',map {              $request->content(join('&',map {
                               my $name = escape($_);                                my $name = escape($_);
Line 755  sub send_grade { Line 785  sub send_grade {
                               ? join("&$name=", map {escape($_) } @{$hashref->{$_}})                                ? join("&$name=", map {escape($_) } @{$hashref->{$_}})
                               : &escape($hashref->{$_}) );                                : &escape($hashref->{$_}) );
                               } keys(%{$hashref})));                                } keys(%{$hashref})));
   #FIXME Need to handle case where passback failed.
         }          }
     } else {      } else {
         srand( time() ^ ($$ + ($$ << 15))  ); # Seed rand.          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 $uniqmsgid = int(rand(2**32));
         my $gradexml = <<END;          my $gradexml = <<END;
 <?xml version = "1.0" encoding = "UTF-8"?>  <?xml version = "1.0" encoding = "UTF-8"?>
Line 791  END Line 821  END
         while (length($bodyhash) % 4) {          while (length($bodyhash) % 4) {
             $bodyhash .= '=';              $bodyhash .= '=';
         }          }
         my $gradereq = Net::OAuth->request('consumer')->new(          my $reqmethod = 'POST';
                            consumer_key => $ckey,          my %info = (
                            consumer_secret => $secret,                        body_hash => $bodyhash,
                            request_url => $url,                        method => $sigmethod,
                            request_method => 'POST',                        reqtype => 'consumer',
                            signature_method => $sigmethod,                        reqmethod => $reqmethod,
                            timestamp => time(),                        respfmt => 'to_authorization_header',
                            nonce => $nonce,                     );
                            body_hash => $bodyhash,          my %params;
         );          my ($status,$authheader) =
         $gradereq->add_required_message_params('body_hash');              &Apache::lonnet::sign_lti($cdom,$cnum,$crsdef,$type,'grade',$url,$ltinum,$keynum,\%params,\%info);
         $gradereq->sign();          if (($status eq 'ok') && ($authheader ne '')) {
         $request = HTTP::Request->new(              $request = HTTP::Request->new(
                $gradereq->request_method,                     $reqmethod,
                $gradereq->request_url,                     $url,
                [                     [
            'Authorization' => $gradereq->to_authorization_header,                'Authorization' => $authheader,
            'Content-Type'  => 'application/xml',                'Content-Type'  => 'application/xml',
                ],                     ],
                $gradexml,                     $gradexml,
         );              );
     }              my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10);
     my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10);              my $message=$response->status_line;
     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 {  sub setup_logout_callback {
     my ($uname,$udom,$server,$ckey,$secret,$service_url,$idsdir,$protocol,$hostname) = @_;      my ($cdom,$cnum,$crstool,$idx,$keynum,$uname,$udom,$server,$service_url,$idsdir,$protocol,$hostname) = @_;
     if ($service_url =~ m{^https?://[^/]+/}) {      if ($service_url =~ m{^https?://[^/]+/}) {
         my $digest_user = &Encode::decode_utf8($uname.':'.$udom);          my $digest_user = &Encode::decode('UTF-8',$uname.':'.$udom);
         my $loginfile = &Digest::SHA::sha1_hex($digest_user).&md5_hex(&md5_hex(time.{}.rand().$$));          my $loginfile = &Digest::SHA::sha1_hex($digest_user).&md5_hex(&md5_hex(time.{}.rand().$$));
         if ((-d $idsdir) && (open(my $fh,'>',"$idsdir/$loginfile"))) {          if ((-d $idsdir) && (open(my $fh,'>',"$idsdir/$loginfile"))) {
             print $fh "$uname,$udom,$server\n";              print $fh "$uname,$udom,$server\n";
Line 830  sub setup_logout_callback { Line 861  sub setup_logout_callback {
             my %ltiparams = (              my %ltiparams = (
                 callback   => $callback,                  callback   => $callback,
             );              );
             my $post = &sign_params($service_url,$ckey,$secret,\%ltiparams,              my %info = (
                                     '','','',1);                  respfmt => 'to_post_body',
             my $request=new HTTP::Request('POST',$service_url);              );
             $request->content($post);              my ($status,$post) = 
             my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10);                  &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;      return;
Line 1065  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 1097  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.17  
changed lines
  Added in v.1.19

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