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

Diff for /loncom/lti/ltiutils.pm between versions 1.4 and 1.10

version 1.4, 2018/01/04 12:09:42 version 1.10, 2018/05/15 04:59:22
Line 34  use Digest::SHA; Line 34  use Digest::SHA;
 use UUID::Tiny ':std';  use UUID::Tiny ':std';
 use Apache::lonnet;  use Apache::lonnet;
 use Apache::loncommon;  use Apache::loncommon;
   use Math::Round();
 use LONCAPA qw(:DEFAULT :match);  use LONCAPA qw(:DEFAULT :match);
   
 #  #
Line 286  sub verify_lis_item { Line 287  sub verify_lis_item {
             my $expected_sig;              my $expected_sig;
             if ($context eq 'grade') {              if ($context eq 'grade') {
                 my $uniqid = $digsymb.':::'.$diguser.':::'.$cdom.'_'.$cnum;                  my $uniqid = $digsymb.':::'.$diguser.':::'.$cdom.'_'.$cnum;
                 $expected_sig = &get_service_id($secret,$uniqid);                  $expected_sig = (split(/:::/,&get_service_id($secret,$uniqid)))[0]; 
                 if ($expected_sig eq $sigrec) {                  if ($expected_sig eq $sigrec) {
                     return 1;                      return 1;
                 } else {                  } else {
Line 294  sub verify_lis_item { Line 295  sub verify_lis_item {
                 }                  }
             } elsif ($context eq 'roster') {              } elsif ($context eq 'roster') {
                 my $uniqid = $digsymb.':::'.$cdom.'_'.$cnum;                  my $uniqid = $digsymb.':::'.$cdom.'_'.$cnum;
                 $expected_sig = &get_service_id($secret,$uniqid);                  $expected_sig = (split(/:::/,&get_service_id($secret,$uniqid)))[0]; 
                 if ($expected_sig eq $sigrec) {                  if ($expected_sig eq $sigrec) {
                     return 1;                      return 1;
                 } else {                  } else {
Line 324  sub sign_params { Line 325  sub sign_params {
     if ($sigmethod eq '') {      if ($sigmethod eq '') {
         $sigmethod = 'HMAC-SHA1';          $sigmethod = 'HMAC-SHA1';
     }      }
       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("request token")->new(
             consumer_key => $key,              consumer_key => $key,
Line 458  sub release_tool_lock { Line 460  sub release_tool_lock {
     }      }
 }  }
   
   #
   # LON-CAPA as LTI Provider
   #
   # Use the part of the launch URL after /adm/lti to determine
   # the scope for the current session (i.e., restricted to a
   # single resource, to a single folder/map, or to an entire
   # course).
   #
   # Returns an array containing scope: resource, map, or course
   # and the LON-CAPA URL that is displayed post-launch, including
   # accommodation of URL encryption, and translation of a tiny URL
   # to the actual URL
   #
   
   sub lti_provider_scope {
       my ($tail,$cdom,$cnum,$getunenc) = @_;
       my ($scope,$realuri,$passkey,$unencsymb);
       if ($tail =~ m{^/?uploaded/$cdom/$cnum/(?:default|supplemental)(?:|_\d+)\.(?:sequence|page)(|___\d+___.+)$}) {
           my $rest = $1;
           if ($rest eq '') {
               $scope = 'map';
               $realuri = $tail;
           } else {
               my ($map,$resid,$url) = &Apache::lonnet::decode_symb($tail);
               $realuri = &Apache::lonnet::clutter($url);
               if ($url =~ /\.sequence$/) {
                   $scope = 'map';
               } else {
                   $scope = 'resource';
                   $realuri .= '?symb='.$tail;
                   $passkey = $tail;
                   if ($getunenc) {
                       $unencsymb = $tail;
                   }
               }
           }
       } elsif ($tail =~ m{^/?res/$match_domain/$match_username/.+\.(?:sequence|page)(|___\d+___.+)$}) {
           my $rest = $1;
           if ($rest eq '') {
               $scope = 'map';
               $realuri = $tail;
           } else {
               my ($map,$resid,$url) = &Apache::lonnet::decode_symb($tail);
               $realuri = &Apache::lonnet::clutter($url);
               if ($url =~ /\.sequence$/) {
                   $scope = 'map';
               } else {
                   $scope = 'resource';
                   $realuri .= '?symb='.$tail;
                   $passkey = $tail;
                   if ($getunenc) {
                       $unencsymb = $tail;
                   }
               }
           }
       } elsif ($tail =~ m{^/tiny/$cdom/(\w+)$}) {
           my $key = $1;
           my $tinyurl;
           my ($result,$cached)=&Apache::lonnet::is_cached_new('tiny',$cdom."\0".$key);
           if (defined($cached)) {
               $tinyurl = $result;
           } else {
               my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
               my %currtiny = &Apache::lonnet::get('tiny',[$key],$cdom,$configuname);
               if ($currtiny{$key} ne '') {
                   $tinyurl = $currtiny{$key};
                   &Apache::lonnet::do_cache_new('tiny',$cdom."\0".$key,$currtiny{$key},600);
               }
           }
           if ($tinyurl ne '') {
               my ($cnum,$symb) = split(/\&/,$tinyurl,2);
               my ($map,$resid,$url) = &Apache::lonnet::decode_symb($symb);
               if ($url =~ /\.(page|sequence)$/) {
                   $scope = 'map';
               } else {
                   $scope = 'resource';
               }
               $passkey = $symb;
               if ((&Apache::lonnet::EXT('resource.0.encrypturl',$symb) =~ /^yes$/i) &&
                   (!$env{'request.role.adv'})) {
                   $realuri = &Apache::lonenc::encrypted(&Apache::lonnet::clutter($url));
                   if ($scope eq 'resource') {
                       $realuri .= '?symb='.&Apache::lonenc::encrypted($symb);
                   }
               } else {
                   $realuri = &Apache::lonnet::clutter($url);
                   if ($scope eq 'resource') {
                       $realuri .= '?symb='.$symb;
                   }
               }
               if ($getunenc) {
                   $unencsymb = $symb;
               }
           }
       } elsif (($tail =~ m{^/$cdom/$cnum$}) || ($tail eq '')) {
           $scope = 'course';
           $realuri = '/adm/navmaps';
           $passkey = $tail;
       }
       if ($scope eq 'map') {
           $passkey = $realuri;
       }
       if (wantarray) {
           return ($scope,$realuri,$unencsymb);
       } else {
           return $passkey;
       }
   }
   
   sub send_grade {
       my ($id,$url,$ckey,$secret,$scoretype,$total,$possible) = @_;
       my $score;
       if ($possible > 0) {
           if ($scoretype eq 'ratio') {
               $score = Math::Round::round($total).'/'.Math::Round::round($possible);
           } elsif ($scoretype eq 'percentage') {
               $score = (100.0*$total)/$possible;
               $score = Math::Round::round($score);
           } else {
               $score = $total/$possible;
               $score = sprintf("%.2f",$score);
           }
       }
       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,\%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.
       }
   }
   
 1;  1;
Removed from v.1.4  
changed lines
  Added in v.1.10

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