--- loncom/interface/lonexttool.pm 2016/01/26 14:30:25 1.3
+++ loncom/interface/lonexttool.pm 2017/12/22 02:00:46 1.12
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Launch External Tool Provider (LTI)
#
-# $Id: lonexttool.pm,v 1.3 2016/01/26 14:30:25 raeburn Exp $
+# $Id: lonexttool.pm,v 1.12 2017/12/22 02:00:46 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -43,13 +43,17 @@ package Apache::lonexttool;
use strict;
use Apache::Constants qw(:common :http);
-use Net::OAuth;
use Encode;
use Digest::SHA;
use HTML::Entities;
use Apache::lonlocal;
use Apache::lonnet;
use Apache::loncommon;
+use Apache::londatecheck;
+use Apache::lonipcheck;
+use Apache::lonhomework;
+use Apache::structuretags;
+use LONCAPA::ltiutils;
sub handler {
my $r=shift;
@@ -62,12 +66,15 @@ sub handler {
# ------------------------------------------------------------ Print the screen
if ($target eq 'tex') {
$r->print(&Apache::lonprintout::print_latex_header($env{'form.latex_type'}));
+ } else {
+ $target = 'web';
}
# Is this even in a course?
unless ($env{'request.course.id'}) {
if ($target ne 'tex') {
- &Apache::loncommon::simple_error_page($r,'','Not in a course');
+ &Apache::loncommon::simple_error_page($r,'','Not in a course',
+ {'only_body' => 1});
} else {
$r->print('\textbf{Not in a course}\end{document}');
}
@@ -89,32 +96,25 @@ sub handler {
my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
my $chome = $env{'course.'.$env{'request.course.id'}.'.home'};
- my $is_tool;
+ my ($idx,$is_tool,%toolhash,%toolsettings);
if ($r->uri eq "/adm/$cdom/$cnum/$marker/$exttool") {
- my %toolsettings=&Apache::lonnet::dump('exttool_'.$marker,$cdom,$cnum);
+ %toolsettings=&Apache::lonnet::dump('exttool_'.$marker,$cdom,$cnum);
if ($toolsettings{'id'}) {
- my %ltitools = &Apache::lonnet::get_domain_ltitools($cdom);
- if (ref($ltitools{$toolsettings{'id'}}) eq 'HASH') {
- my %toolhash = %{$ltitools{$toolsettings{'id'}}};
+ $idx = $toolsettings{'id'};
+ my %ltitools = &Apache::lonnet::get_domain_lti($cdom,'consumer');
+ if (ref($ltitools{$idx}) eq 'HASH') {
+ %toolhash = %{$ltitools{$idx}};
$toolhash{'display'} = {
target => $toolsettings{'target'},
width => $toolsettings{'width'},
height => $toolsettings{'height'},
};
+ $toolhash{'crslabel'} = $toolsettings{'crslabel'};
+ $toolhash{'crstitle'} = $toolsettings{'crstitle'};
+ $toolhash{'crsappend'} = $toolsettings{'crsappend'};
+ $toolhash{'gradable'} = $toolsettings{'gradable'};
$is_tool = 1;
- if ($target eq 'tex') {
- $r->print(&mt('External Tool'));
- } else {
- my $submittext = &mt('Launch [_1]',$toolhash{'title'});
- if (($toolhash{'key'} ne '') && ($toolhash{'secret'} ne '') && ($toolhash{'url'} ne '')) {
- my %lti = <i_params($r,$submittext,\%toolhash);
- $r->print(&launch_html($toolhash{'url'},$toolhash{'key'},
- $toolhash{'secret'},$submittext,\%lti));
- } else {
- $r->print('
'.&mt('External Tool Unavailable').'
');
- }
- }
}
}
}
@@ -124,19 +124,95 @@ sub handler {
} else {
$r->print('\textbf{'.&mt(Invalid Call).'}\end{document}');
}
+ return OK;
+ }
+
+ my ($status,$open,$close,$msg);
+ if ($toolhash{'gradable'}) {
+ $Apache::lonhomework::browse = &Apache::lonnet::allowed('bre',$r->uri);
+ if ($env{'form.markaccess'}) {
+ my @interval=&Apache::lonnet::EXT("resource.0.interval");
+ my ($timelimit) = split(/_/,$interval[0]);
+ &Apache::lonnet::set_first_access($interval[1],$timelimit);
+ }
+ ($status,$msg) = &gradabletool_access_check();
+ undef($Apache::lonhomework::browse);
+ if ($status eq 'SHOW_ANSWER') {
+ $r->print(&display_score());
+ return OK;
+ } elsif ($status ne 'CAN_ANSWER') {
+ $r->print($msg);
+ return OK;
+ }
+ } else {
+ my ($status,$open,$close,$msg)=&Apache::londatecheck::content_date_check();
+ if ($status ne 'OPEN') {
+ if ($target eq 'tex') {
+ $r->print(&mt('Not open to be viewed'));
+ } else {
+ $r->print($msg);
+ }
+ return OK;
+ } else {
+ ($status,$msg)=&Apache::lonipcheck::ip_access_check();
+ if ($status ne 'OPEN') {
+ if ($target eq 'tex') {
+ $r->print(&mt('Not open to be viewed'));
+ } else {
+ $r->print($msg);
+ }
+ return OK;
+ }
+ }
+ }
+ my $launchok = 1;
+ if ($target eq 'tex') {
+ $r->print(&mt('External Tool'));
+ } else {
+ my $now = time;
+ if ($toolhash{'passback'}) {
+ if (&LONCAPA::ltiutils::set_service_secret($cdom,$cnum,$marker,'grade',$now,
+ \%toolsettings,\%toolhash) eq 'ok') {
+ $toolhash{'gradesecret'} = $toolsettings{'gradesecret'};
+ } else {
+ undef($launchok);
+ }
+ }
+ if ($toolhash{'roster'}) {
+ if (&LONCAPA::ltiutils::set_service_secret($cdom,$cnum,$marker,'roster',$now,
+ \%toolsettings,\%toolhash) eq 'ok') {
+ $toolhash{'rostersecret'} = $toolsettings{'rostersecret'};
+ }
+ }
+ my $submittext = &mt('Launch [_1]',$toolhash{'title'});
+ if (($toolhash{'key'} ne '') && ($toolhash{'secret'} ne '') &&
+ ($toolhash{'url'} ne '') && ($launchok)) {
+ my %lti = <i_params($r,$cnum,$cdom,$idx,$submittext,\%toolhash);
+ my $url = $toolhash{'url'};
+ if ($toolhash{'crsappend'} ne '') {
+ $url .= $toolhash{'crsappend'};
+ }
+ $r->print(&launch_html($url,$toolhash{'key'},$toolhash{'secret'},
+ $submittext,\%lti));
+ } else {
+ $r->print(''.&mt('External Tool Unavailable').'
');
+ }
}
return OK;
}
sub lti_params {
- my ($r,$submittext,$toolsref) = @_;
+ my ($r,$cnum,$cdom,$idx,$submittext,$toolsref) = @_;
my ($version,$context_type,$msgtype,$toolname,$passback,$roster,$locale,
- %fields,%rolesmap,%display,%custom,@userlangs);
+ $crslabel,$crstitle,$gradesecret,$rostersecret,%fields,%rolesmap,
+ %display,%custom,@userlangs);
if (ref($toolsref) eq 'HASH') {
$version = $toolsref->{'version'};
$toolname = $toolsref->{'title'};
$passback = $toolsref->{'passback'};
+ $gradesecret = $toolsref->{'gradesecret'};
$roster = $toolsref->{'roster'};
+ $rostersecret = $toolsref->{'rostersecret'};
$msgtype = $toolsref->{'messagetype'};
if (ref($toolsref->{'fields'}) eq 'HASH') {
%fields = %{$toolsref->{'fields'}};
@@ -150,6 +226,8 @@ sub lti_params {
if (ref($toolsref->{'custom'}) eq 'HASH') {
%custom = %{$toolsref->{'custom'}};
}
+ $crslabel = $toolsref->{'crslabel'};
+ $crstitle = $toolsref->{'crstitle'};
}
if ($version eq '') {
$version = 'LTI-1p0';
@@ -160,6 +238,12 @@ sub lti_params {
if ($msgtype eq '') {
$msgtype = 'basic-lti-launch-request';
}
+ if ($crslabel eq '') {
+ $crslabel = $env{'course.'.$env{'request.course.id'}.'.internal.coursecode'},
+ }
+ if ($crstitle eq '') {
+ $crstitle = $env{'course.'.$env{'request.course.id'}.'.description'},;
+ }
my $lonhost = $r->dir_config('lonHostID');
my $loncaparev = $r->dir_config('lonVersion');
my $uname = $env{'user.name'};
@@ -202,21 +286,28 @@ sub lti_params {
}
}
}
+ my $domdesc = &Apache::lonnet::domain($cdom);
+ my $primary_id = &Apache::lonnet::domain($cdom,'primary');
+ my $int_dom = &Apache::lonnet::internet_dom($primary_id);
+ my $portal_url = &Apache::lonnet::course_portal_url($cnum,$cdom);
+
my %ltiparams = (
lti_version => $version,
lti_message_type => $msgtype,
resource_link_title => $title,
resource_link_id => $digest_symb,
tool_consumer_instance_guid => $lonhost,
+ tool_consumer_instance_description => $domdesc,
tool_consumer_info_product_family_code => 'loncapa',
+ tool_consumer_instance_name => $int_dom,
+ tool_consumer_instance_url => $portal_url,
tool_consumer_info_version => $loncaparev,
user_id => $digest_user,
- lis_person_sourcedid => $uname.':'.$udom,
roles => $ltirole,
context_id => $env{'request.course.id'},
context_type => $context_type,
- context_label => $env{'course.'.$env{'request.course.id'}.'.internal.coursecode'},
- context_title => $env{'course.'.$env{'request.course.id'}.'.description'},
+ context_label => $crslabel,
+ context_title => $crstitle,
launch_presentation_locale => $locale,
);
my $crshome = $env{'course.'.$env{'request.course.id'}.'.home'};
@@ -225,18 +316,40 @@ sub lti_params {
my $crsprotocol = $Apache::lonnet::protocol{$crshome};
unless ($crsprotocol eq 'https') {
$crsprotocol = 'http';
- }
- if ($passback) {
- if ($ltirole eq 'Learner') {
- $ltiparams{'lis_outcome_service_url'} = $crsprotocol.'//'.$crshostname.'/adm/ltipassback';
+ }
+ if (($passback) || ($roster)) {
+ if ($passback) {
+ $ltiparams{'lis_outcome_service_url'} = $crsprotocol.'://'.$crshostname.'/adm/service/passback';
$ltiparams{'ext_ims_lis_basic_outcome_url'} = $ltiparams{'lis_outcome_service_url'};
- $ltiparams{'lis_result_sourcedid'} = ''; #FIXME
+ if ($gradesecret) {
+ my $uniqid = $digest_symb.':::'.$digest_user.':::'.$env{'request.course.id'};
+ $ltiparams{'lis_result_sourcedid'} = &LONCAPA::ltiutils::get_service_id($gradesecret,$uniqid);
+ }
}
- }
- if ($roster) {
- if (&Apache::lonnet::allowed('opa',$env{'request.course.id'})) {
- $ltiparams{'ext_ims_lis_memberships_url'} = $crsprotocol.'//'.$crshostname.'/adm/ltiroster';
- $ltiparams{'ext_ims_lis_memberships_id'} = ''; #FIXME
+ if ($roster) {
+ if (&Apache::lonnet::allowed('opa',$env{'request.course.id'})) {
+ $ltiparams{'ext_ims_lis_memberships_url'} = $crsprotocol.'://'.$crshostname.'/adm/service/roster';
+ if ($rostersecret) {
+ my $uniqid = $digest_symb.':::'.$env{'request.course.id'};
+ $ltiparams{'ext_ims_lis_memberships_id'} = &LONCAPA::ltiutils::get_service_id($rostersecret,$uniqid);
+ }
+ }
+ }
+ my %digesthash;
+ if ($ltiparams{'lis_result_sourcedid'}) {
+ $digesthash{$ltiparams{'lis_result_sourcedid'}} = "$idx\0".time;
+ }
+ if ($ltiparams{'ext_ims_lis_memberships_id'}) {
+ $digesthash{$ltiparams{'ext_ims_lis_memberships_id'}} = "$idx\0".time;
+ }
+ if (($digest_symb) && ($gradesecret || $rostersecret)) {
+ $digesthash{$digest_symb} = $symb;
+ }
+ if (($passback) && ($gradesecret)) {
+ $digesthash{$digest_user} = $uname.':'.$udom;
+ }
+ if (keys(%digesthash)) {
+ &Apache::lonnet::put('exttools',\%digesthash,$cdom,$cnum);
}
}
}
@@ -269,9 +382,19 @@ sub lti_params {
}
$ltiparams{'lis_person_contact_email_primary'} = $contact_email;
}
+ if ($fields{'user'}) {
+ $ltiparams{'lis_person_sourcedid'} = $uname.':'.$udom;
+ }
if (keys(%custom)) {
foreach my $key (keys(%custom)) {
- $ltiparams{'custom_'.$key} = $custom{$key};
+ my $value = $custom{$key};
+ $value =~ s/^\s+|\s+\$//g;
+ if ($value =~ /^\QLONCAPA::env{\E([^\}]+)\}$/) {
+ if (exists($env{$1})) {
+ $value = $env{$1};
+ }
+ }
+ $ltiparams{'custom_'.$key} = $value;
}
}
foreach my $key (keys(%ltiparams)) {
@@ -283,13 +406,14 @@ sub lti_params {
sub launch_html {
my ($url,$key,$secret,$submittext,$paramsref) = @_;
- my $hashref = &sign_params($url,$key,$secret,$paramsref);
+ my $hashref = &LONCAPA::ltiutils::sign_params($url,$key,$secret,$paramsref);
+ my $action = &HTML::Entities::encode($url,'<>&"');
my $form = <<"END";