# The LearningOnline Network with CAPA
# Utility functions for managing LON-CAPA LTI interactions
#
# $Id: ltiutils.pm,v 1.3 2017/12/30 14:04:00 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
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
#
# Determine if a nonce in POSTed data has expired.
# If unexpired, confirm it has not already been used.
#
# When LON-CAPA is operating as a Consumer, nonce checking
# occurs when a Tool Provider launched from an instance of
# an external tool in a LON-CAPA course makes a request to
# (a) /adm/service/roster or (b) /adm/service/passback to,
# 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) = @_;
if (($ltidir eq '') || ($timestamp eq '') || ($timestamp =~ /^\D/) ||
($lifetime eq '') || ($lifetime =~ /\D/) || ($domain eq '')) {
return;
}
my $now = time;
if (($timestamp) && ($timestamp < ($now - $lifetime))) {
return;
}
if ($nonce eq '') {
return;
}
if (-e "$ltidir/$domain/$nonce") {
return;
} else {
unless (-e "$ltidir/$domain") {
unless (mkdir("$ltidir/$domain",0755)) {
return;
}
}
if (open(my $fh,'>',"$ltidir/$domain/$nonce")) {
print $fh $now;
close($fh);
return 1;
}
}
return;
}
#
# LON-CAPA as LTI Consumer
#
# Determine the domain and the courseID of the LON-CAPA course
# for which access is needed by a Tool Provider -- either to
# retrieve a roster or store the grade for an instance of an
# external tool in the course.
#
sub get_loncapa_course {
my ($lonhost,$cid,$errors) = @_;
return unless (ref($errors) eq 'HASH');
my ($cdom,$cnum);
if ($cid =~ /^($match_domain)_($match_courseid)$/) {
my ($posscdom,$posscnum) = ($1,$2);
my $cprimary_id = &Apache::lonnet::domain($posscdom,'primary');
if ($cprimary_id eq '') {
$errors->{5} = 1;
return;
} else {
my @intdoms;
my $internet_names = &Apache::lonnet::get_internet_names($lonhost);
if (ref($internet_names) eq 'ARRAY') {
@intdoms = @{$internet_names};
}
my $cintdom = &Apache::lonnet::internet_dom($cprimary_id);
if (($cintdom ne '') && (grep(/^\Q$cintdom\E$/,@intdoms))) {
$cdom = $posscdom;
} else {
$errors->{6} = 1;
return;
}
}
my $chome = &Apache::lonnet::homeserver($posscnum,$posscdom);
if ($chome =~ /(con_lost|no_host|no_such_host)/) {
$errors->{7} = 1;
return;
} else {
$cnum = $posscnum;
}
} else {
$errors->{8} = 1;
return;
}
return ($cdom,$cnum);
}
#
# LON-CAPA as LTI Consumer
#
# Determine the symb and (optionally) LON-CAPA user for an
# instance of an external tool in a course -- either to
# to retrieve a roster or store a grade.
#
# Use the digested symb to lookup the real symb in exttools.db
# and the digested userID to lookup the real userID (if needed).
# and extract the exttool instance and symb.
#
sub get_tool_instance {
my ($cdom,$cnum,$digsymb,$diguser,$errors) = @_;
return unless (ref($errors) eq 'HASH');
my ($marker,$symb,$uname,$udom);
my @keys = ($digsymb);
if ($diguser) {
push(@keys,$diguser);
}
my %digesthash = &Apache::lonnet::get('exttools',\@keys,$cdom,$cnum);
if ($digsymb) {
$symb = $digesthash{$digsymb};
if ($symb) {
my ($map,$id,$url) = split(/___/,$symb);
$marker = (split(m{/},$url))[3];
$marker=~s/\D//g;
} else {
$errors->{9} = 1;
}
}
if ($diguser) {
if ($digesthash{$diguser} =~ /^($match_username):($match_domain)$/) {
($uname,$udom) = ($1,$2);
} else {
$errors->{10} = 1;
}
return ($marker,$symb,$uname,$udom);
} else {
return ($marker,$symb);
}
}
#
# 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.
#
sub verify_request {
my ($params,$protocol,$hostname,$requri,$reqmethod,$consumer_secret,$errors) = @_;
return unless (ref($errors) eq 'HASH');
my $request = Net::OAuth->request('request token')->from_hash($params,
request_url => $protocol.'://'.$hostname.$requri,
request_method => $reqmethod,
consumer_secret => $consumer_secret,);
unless ($request->verify()) {
$errors->{15} = 1;
return;
}
}
#
# 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 = &get_service_id($secret,$uniqid);
if ($expected_sig eq $sigrec) {
return 1;
} else {
$errors->{17} = 1;
}
} elsif ($context eq 'roster') {
my $uniqid = $digsymb.':::'.$cdom.'_'.$cnum;
$expected_sig = &get_service_id($secret,$uniqid);
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
# too in a LON-CAPA course, using the key and secret supplied
# by the Tool Provider.
#
sub sign_params {
my ($url,$key,$secret,$sigmethod,$paramsref) = @_;
return unless (ref($paramsref) eq 'HASH');
if ($sigmethod eq '') {
$sigmethod = 'HMAC-SHA1';
}
my $nonce = Digest::SHA::sha1_hex(sprintf("%06x%06x",rand(0xfffff0),rand(0xfffff0)));
my $request = Net::OAuth->request("request token")->new(
consumer_key => $key,
consumer_secret => $secret,
request_url => $url,
request_method => 'POST',
signature_method => $sigmethod,
timestamp => time,
nonce => $nonce,
callback => 'about:blank',
extra_params => $paramsref,
version => '1.0',
);
$request->sign;
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';
}
}
1;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to ltiutils.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / lti