--- loncom/lti/ltiutils.pm	2018/05/15 04:33:17	1.9
+++ loncom/lti/ltiutils.pm	2020/04/09 23:17:19	1.9.2.1
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # Utility functions for managing LON-CAPA LTI interactions 
 #
-# $Id: ltiutils.pm,v 1.9 2018/05/15 04:33:17 raeburn Exp $
+# $Id: ltiutils.pm,v 1.9.2.1 2020/04/09 23:17:19 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -31,13 +31,12 @@ package LONCAPA::ltiutils;
 use strict;
 use Net::OAuth;
 use Digest::SHA;
-use UUID::Tiny ':std';
 use Apache::lonnet;
 use Apache::loncommon;
 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.
 # If unexpired, confirm it has not already been used.
@@ -49,11 +48,6 @@ use LONCAPA qw(:DEFAULT :match);
 # respectively, retrieve a roster or store the grade for 
 # 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 {
     my ($nonce,$timestamp,$lifetime,$domain,$ltidir) = @_;
@@ -178,58 +172,6 @@ sub get_tool_instance {
 #
 # 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
 # secret for the specific LTI Provider.
 #
@@ -250,69 +192,6 @@ sub verify_request {
 #
 # 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
 # tool in a LON-CAPA course, using the key and secret supplied 
 # by the Tool Provider.
@@ -342,210 +221,4 @@ sub sign_params {
     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;