# The LearningOnline Network with CAPA
# Utility functions for managing LON-CAPA LTI interactions
#
# $Id: ltiutils.pm,v 1.9.2.1 2020/04/09 23:17:19 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 Apache::lonnet;
use Apache::loncommon;
use LONCAPA qw(:DEFAULT :match);
#
# LON-CAPA as LTI Consumer
#
# 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.
#
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
#
# 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
#
# 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.
#
sub sign_params {
my ($url,$key,$secret,$sigmethod,$paramsref) = @_;
return unless (ref($paramsref) eq 'HASH');
if ($sigmethod eq '') {
$sigmethod = 'HMAC-SHA1';
}
srand( time() ^ ($$ + ($$ << 15)) ); # Seed rand.
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();
}
1;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>