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

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

version 1.9.2.1, 2020/04/09 23:17:19 version 1.10, 2018/05/15 04:59:22
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 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);
   
 #  #
 # LON-CAPA as LTI Consumer  # LON-CAPA as LTI Consumer or LTI Provider
 #  #
 # Determine if a nonce in POSTed data has expired.  # Determine if a nonce in POSTed data has expired.
 # If unexpired, confirm it has not already been used.  # If unexpired, confirm it has not already been used.
Line 48  use LONCAPA qw(:DEFAULT :match); Line 50  use LONCAPA qw(:DEFAULT :match);
 # respectively, retrieve a roster or store the grade for   # respectively, retrieve a roster or store the grade for 
 # the original launch by a specific user.  # the original launch by a specific user.
 #  #
   # When LON-CAPA is operating as a Provider, nonce checking 
   # occurs when a user in course context in another LMS (the 
   # Consumer) launches an external tool to access a LON-CAPA URL: 
   # /adm/lti/ with LON-CAPA symb, map, or deep-link ID appended.
   #
   
 sub check_nonce {  sub check_nonce {
     my ($nonce,$timestamp,$lifetime,$domain,$ltidir) = @_;      my ($nonce,$timestamp,$lifetime,$domain,$ltidir) = @_;
Line 172  sub get_tool_instance { Line 179  sub get_tool_instance {
 #  #
 # LON-CAPA as LTI Consumer  # LON-CAPA as LTI Consumer
 #  #
   # Retrieve data needed to validate a request from a Tool Provider
   # for a roster or to store a grade for an instance of an external 
   # tool in a LON-CAPA course.
   #
   # Retrieve the Consumer key and Consumer secret from the domain 
   # configuration or the Tool Provider ID stored in the
   # exttool_$marker db file and compare the Consumer key with the
   # one in the POSTed data.
   #
   # Side effect is to populate the $toolsettings hashref with the 
   # contents of the .db file (instance of tool in course) and the
   # $ltitools hashref with the configuration for the tool (at
   # domain level).
   #
   
   sub get_tool_secret {
       my ($key,$marker,$symb,$cdom,$cnum,$toolsettings,$ltitools,$errors) = @_;
       return unless ((ref($toolsettings) eq 'HASH') && (ref($ltitools) eq 'HASH') &&
                      (ref($errors) eq 'HASH'));
       my ($consumer_secret,$nonce_lifetime);
       if ($marker) {
           %{$toolsettings}=&Apache::lonnet::dump('exttool_'.$marker,$cdom,$cnum);
           if ($toolsettings->{'id'}) {
               my $idx = $toolsettings->{'id'};
               my %lti = &Apache::lonnet::get_domain_lti($cdom,'consumer');
               if (ref($lti{$idx}) eq 'HASH') {
                   %{$ltitools} = %{$lti{$idx}};
                   if ($ltitools->{'key'} eq $key) {
                       $consumer_secret = $ltitools->{'secret'};
                       $nonce_lifetime = $ltitools->{'lifetime'};
                   } else {
                       $errors->{11} = 1;
                       return;
                   }
               } else {
                   $errors->{12} = 1;
                   return;
               }
           } else {
               $errors->{13} = 1;
               return;
           }
       } else {
           $errors->{14};
           return;
       }
       return ($consumer_secret,$nonce_lifetime);
   }
   
   #
   # LON-CAPA as LTI Consumer
   #
 # Verify a signed request using the consumer_key and  # Verify a signed request using the consumer_key and
 # secret for the specific LTI Provider.  # secret for the specific LTI Provider.
 #  #
Line 192  sub verify_request { Line 251  sub verify_request {
 #  #
 # LON-CAPA as LTI Consumer  # LON-CAPA as LTI Consumer
 #  #
   # Verify that an item identifier (either roster request:
   # ext_ims_lis_memberships_id, or grade store:
   # lis_result_sourcedid) has not been tampered with, and
   # the secret used to create the unique identifier has not
   # expired.
   #
   # Prepending the current secret (if still valid),
   # or the previous secret (if current one is no longer valid),
   # to a string composed of the :::-separated components
   # must generate the result signature in the lis item ID
   # sent by the Tool Provider.
   #
   
   sub verify_lis_item {
       my ($sigrec,$context,$digsymb,$diguser,$cdom,$cnum,$toolsettings,$ltitools,$errors) = @_;
       return unless ((ref($toolsettings) eq 'HASH') && (ref($ltitools) eq 'HASH') && 
                      (ref($errors) eq 'HASH'));
       my ($has_action, $valid_for);
       if ($context eq 'grade') {
           $has_action = $ltitools->{'passback'};
           $valid_for = $ltitools->{'passbackvalid'}
       } elsif ($context eq 'roster') {
           $has_action = $ltitools->{'roster'};
           $valid_for = $ltitools->{'rostervalid'};
       }
       if ($has_action) {
           my $secret;
           if (($toolsettings->{$context.'secretdate'} + $valid_for) > time) {
               $secret = $toolsettings->{$context.'secret'};
           } else {
               $secret = $toolsettings->{'old'.$context.'secret'};
           }
           if ($secret) {
               my $expected_sig;
               if ($context eq 'grade') {
                   my $uniqid = $digsymb.':::'.$diguser.':::'.$cdom.'_'.$cnum;
                   $expected_sig = (split(/:::/,&get_service_id($secret,$uniqid)))[0]; 
                   if ($expected_sig eq $sigrec) {
                       return 1;
                   } else {
                       $errors->{17} = 1;
                   }
               } elsif ($context eq 'roster') {
                   my $uniqid = $digsymb.':::'.$cdom.'_'.$cnum;
                   $expected_sig = (split(/:::/,&get_service_id($secret,$uniqid)))[0]; 
                   if ($expected_sig eq $sigrec) {
                       return 1;
                   } else {
                       $errors->{18} = 1;
                   }
               }
           } else {
               $errors->{19} = 1;
           }
       } else {
           $errors->{20} = 1;
       }
       return;
   }
   
   #
   # LON-CAPA as LTI Consumer
   #
 # Sign a request used to launch an instance of an external  # Sign a request used to launch an instance of an external
 # tool in a LON-CAPA course, using the key and secret supplied   # tool in a LON-CAPA course, using the key and secret supplied 
 # by the Tool Provider.  # by the Tool Provider.
Line 221  sub sign_params { Line 343  sub sign_params {
     return $request->to_hash();      return $request->to_hash();
 }  }
   
   #
   # LON-CAPA as LTI Consumer
   #
   # Generate a signature for a unique identifier (roster request:
   # ext_ims_lis_memberships_id, or grade store: lis_result_sourcedid)
   #
   
   sub get_service_id {
       my ($secret,$id) = @_;
       my $sig = Digest::SHA::sha1_hex($secret.':::'.$id);
       return $sig.':::'.$id;
   }
   
   #
   # LON-CAPA as LTI Consumer
   #
   # Generate and store the time-limited secret used to create the
   # signature in a service request identifier (roster request or
   # grade store). An existing secret past its expiration date
   # will be stored as old<service name>secret, and a new secret
   # <service name>secret will be stored.
   # 
   # Secrets are specific to service name and to the tool instance 
   # (and are stored in the exttool_$marker db file).
   # The time period a secret remains valid is determined by the 
   # domain configuration for the specific tool and the service.
   # 
   
   sub set_service_secret {
       my ($cdom,$cnum,$marker,$name,$now,$toolsettings,$ltitools) = @_;
       return unless ((ref($toolsettings) eq 'HASH') && (ref($ltitools) eq 'HASH'));
       my $warning;
       my ($needsnew,$oldsecret,$lifetime);
       if ($name eq 'grade') {
           $lifetime = $ltitools->{'passbackvalid'}
       } elsif ($name eq 'roster') {
           $lifetime = $ltitools->{'rostervalid'};
       }
       if ($toolsettings->{$name} eq '') {
           $needsnew = 1;
       } elsif (($toolsettings->{$name.'date'} + $lifetime) < $now) {
           $oldsecret = $toolsettings->{$name.'secret'};
           $needsnew = 1;
       }
       if ($needsnew) {
           if (&get_tool_lock($cdom,$cnum,$marker,$name,$now) eq 'ok') {
               my $secret = UUID::Tiny::create_uuid_as_string(UUID_V4);
               $toolsettings->{$name.'secret'} = $secret;
               my %secrethash = (
                              $name.'secret' => $secret,
                              $name.'secretdate' => $now,
                             );
               if ($oldsecret ne '') {
                   $secrethash{'old'.$name.'secret'} = $oldsecret;
               }
               my $putres = &Apache::lonnet::put('exttool_'.$marker,
                                                 \%secrethash,$cdom,$cnum);
               my $delresult = &release_tool_lock($cdom,$cnum,$marker,$name);
               if ($delresult ne 'ok') {
                   $warning = $delresult ;
               }
               if ($putres eq 'ok') {
                   return 'ok';
               }
           } else {
               $warning = 'Could not obtain exclusive lock';
           }
       } else {
           return 'ok';
       }
       return;
   }
   
   #
   # LON-CAPA as LTI Consumer
   #
   # Add a lock key to exttools.db for the instance of an external tool 
   # when generating and storing a service secret.
   #
   
   sub get_tool_lock {
       my ($cdom,$cnum,$marker,$name,$now) = @_;
       # get lock for tool for which secret is being set
       my $lockhash = {
                        $name."\0".$marker."\0".'lock' => $now.':'.$env{'user.name'}.
                                                          ':'.$env{'user.domain'},
                      };
       my $tries = 0;
       my $gotlock = &Apache::lonnet::newput('exttools',$lockhash,$cdom,$cnum);
   
       while (($gotlock ne 'ok') && $tries <3) {
           $tries ++;
           sleep(1);
           $gotlock = &Apache::lonnet::newput('exttools',$lockhash,$cdom,$cnum);
       }
       return $gotlock;
   }
   
   #
   # LON-CAPA as LTI Consumer
   #
   # Remove a lock key from exttools.db for the instance of an external
   # tool created when generating and storing a service secret.
   #
   
   sub release_tool_lock {
       my ($cdom,$cnum,$marker,$name) = @_;
       #  remove lock
       my @del_lock = ($name."\0".$marker."\0".'lock');
       my $dellockoutcome=&Apache::lonnet::del('exttools',\@del_lock,$cdom,$cnum);
       if ($dellockoutcome ne 'ok') {
           return 'Warning: failed to release lock for exttool';
       } else {
           return 'ok';
       }
   }
   
   #
   # 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.9.2.1  
changed lines
  Added in v.1.10

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