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

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

version 1.8, 2018/04/17 14:03:01 version 1.9.2.1, 2020/04/09 23:17:19
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 LONCAPA qw(:DEFAULT :match);  use LONCAPA qw(:DEFAULT :match);
   
 #  #
 # LON-CAPA as LTI Consumer or LTI Provider  # LON-CAPA as LTI Consumer
 #  #
 # 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 49  use LONCAPA qw(:DEFAULT :match); Line 48  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 178  sub get_tool_instance { Line 172  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 250  sub verify_request { Line 192  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 324  sub sign_params { Line 203  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 341  sub sign_params { Line 221  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) = @_;  
     my ($scope,$realuri);  
     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;  
             }  
         }  
     } 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;  
             }  
         }  
     } 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';  
             }  
             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;  
                 }  
             }  
         }  
     } elsif ($tail =~ m{^/$cdom/$cnum$}) {  
         $scope = 'course';  
         $realuri = '/adm/navmaps';  
     }  
     return ($scope,$realuri);  
 }  
   
 1;  1;
Removed from v.1.8  
changed lines
  Added in v.1.9.2.1

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