Annotation of loncom/interface/lonexttool.pm, revision 1.1
1.1 ! raeburn 1: # The LearningOnline Network with CAPA
! 2: # Launch External Tool Provider (LTI)
! 3: #
! 4: # $Id: lonexttool.pm,v 1.1 2016/01/11 11:40:00 raeburn Exp $
! 5: #
! 6: # Copyright Michigan State University Board of Trustees
! 7: #
! 8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
! 9: #
! 10: # LON-CAPA is free software; you can redistribute it and/or modify
! 11: # it under the terms of the GNU General Public License as published by
! 12: # the Free Software Foundation; either version 2 of the License, or
! 13: # (at your option) any later version.
! 14: #
! 15: # LON-CAPA is distributed in the hope that it will be useful,
! 16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
! 17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
! 18: # GNU General Public License for more details.
! 19: #
! 20: # You should have received a copy of the GNU General Public License
! 21: # along with LON-CAPA; if not, write to the Free Software
! 22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
! 23: #
! 24: # /home/httpd/html/adm/gpl.txt
! 25: #
! 26: # http://www.lon-capa.org/
! 27: #
! 28:
! 29: =pod
! 30:
! 31: =head1 NAME
! 32:
! 33: Apache::lonexttool - Tool Provider launcher
! 34:
! 35: =head1 SYNOPSIS
! 36:
! 37:
! 38: =head1 OVERVIEW
! 39:
! 40: =cut
! 41:
! 42: package Apache::lonexttool;
! 43:
! 44: use strict;
! 45: use Apache::Constants qw(:common :http);
! 46: use Net::OAuth;
! 47: use Encode;
! 48: use Digest::SHA;
! 49: use HTML::Entities;
! 50: use Apache::lonlocal;
! 51: use Apache::lonnet;
! 52: use Apache::loncommon;
! 53:
! 54: sub handler {
! 55: my $r=shift;
! 56: &Apache::loncommon::content_type($r,'text/html');
! 57: $r->send_http_header;
! 58:
! 59: return OK if $r->header_only;
! 60:
! 61: my $target=$env{'form.grade_target'};
! 62: # ------------------------------------------------------------ Print the screen
! 63: if ($target eq 'tex') {
! 64: $r->print(&Apache::lonprintout::print_latex_header($env{'form.latex_type'}));
! 65: }
! 66:
! 67: # Is this even in a course?
! 68: unless ($env{'request.course.id'}) {
! 69: if ($target ne 'tex') {
! 70: &Apache::loncommon::simple_error_page($r,'','Not in a course');
! 71: } else {
! 72: $r->print('\textbf{Not in a course}\end{document}');
! 73: }
! 74: return OK;
! 75: }
! 76:
! 77: my $marker = (split(m{/},$r->uri))[4];
! 78: $marker=~s/\D//g;
! 79:
! 80: if (!$marker) {
! 81: if ($target ne 'tex') {
! 82: &Apache::loncommon::simple_error_page($r,'Invalid Call',
! 83: 'Invalid Call');
! 84: } else {
! 85: $r->print('\textbf{Invalid call}\end{document}');
! 86: }
! 87: return OK;
! 88: }
! 89:
! 90: my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
! 91: my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
! 92: my $chome = $env{'course.'.$env{'request.course.id'}.'.home'};
! 93:
! 94: if ($r->uri eq "/adm/$cdom/$cnum/$marker/exttool") {
! 95: my %toolhash=&Apache::lonnet::dump('exttool_'.$marker,$cdom,$cnum);
! 96: if ($target eq 'tex') {
! 97: $r->print(&mt('External Tool'));
! 98: } else {
! 99: if (($toolhash{'key'} ne '') && ($toolhash{'secret'} ne '') && ($toolhash{'url'} ne '')) {
! 100: my %lti = <i_params($r,\%toolhash);
! 101: $r->print(&launch_html($toolhash{'url'},$toolhash{'key'},
! 102: $toolhash{'secret'},$toolhash{'title'},\%lti));
! 103: } else {
! 104: &Apache::loncommon::simple_error_page($r,'External Tool Unavailable',
! 105: 'External Tool Unavailable');
! 106: }
! 107: }
! 108: } else {
! 109: if ($target ne 'tex') {
! 110: &Apache::loncommon::simple_error_page($r,'Invalid Call',
! 111: 'Invalid Call');
! 112: } else {
! 113: $r->print('\textbf{Invalid call}\end{document}');
! 114: }
! 115: return OK;
! 116: }
! 117:
! 118: &print_end_page($r,$target);
! 119: return OK;
! 120: }
! 121:
! 122: sub print_end_page {
! 123: my ($r,$target) = @_;
! 124: if ($target ne 'tex') {
! 125: $r->print(&Apache::loncommon::end_page());
! 126: } else {
! 127: $r->print('\end{document}');
! 128: }
! 129: }
! 130:
! 131: sub lti_params {
! 132: my ($r,$toolsref) = @_;
! 133: my ($version,$context_type,$msgtype,$toolname,$passback,$roster,$locale,
! 134: %fields,%rolesmap,%display,%custom,@userlangs);
! 135: if (ref($toolsref) eq 'HASH') {
! 136: $version = $toolsref->{'version'};
! 137: $toolname = $toolsref->{'title'};
! 138: $passback = $toolsref->{'passback'};
! 139: $roster = $toolsref->{'roster'};
! 140: $msgtype = $toolsref->{'messagetype'};
! 141: if (ref($toolsref->{'fields'}) eq 'HASH') {
! 142: %fields = %{$toolsref->{'fields'}};
! 143: }
! 144: if (ref($toolsref->{'roles'}) eq 'HASH') {
! 145: %rolesmap = %{$toolsref->{'roles'}};
! 146: }
! 147: if (ref($toolsref->{'display'}) eq 'HASH') {
! 148: %display = %{$toolsref->{'display'}};
! 149: }
! 150: if (ref($toolsref->{'custom'}) eq 'HASH') {
! 151: %custom = %{$toolsref->{'custom'}};
! 152: }
! 153: }
! 154: if ($version eq '') {
! 155: $version = 'LTI-1p0';
! 156: }
! 157: if ($context_type eq '') {
! 158: $context_type = 'CourseSection';
! 159: }
! 160: if ($msgtype eq '') {
! 161: $msgtype = 'basic-lti-launch-request';
! 162: }
! 163: my $lonhost = $r->dir_config('lonHostID');
! 164: my $loncaparev = $r->dir_config('lonVersion');
! 165: my $uname = $env{'user.name'};
! 166: my $udom = $env{'user.domain'};
! 167: my @possroles = qw(Instructor ContentDeveloper TeachingAssistant Learner);
! 168: my $ltirole = $rolesmap{$env{'request.role'}};
! 169: unless (grep(/^\Q$ltirole\E$/,@possroles)) {
! 170: $ltirole = 'Learner';
! 171: }
! 172: my $digest_user = &Encode::decode_utf8($uname.':'.$udom);
! 173: $digest_user = &Digest::SHA::sha1_hex($digest_user);
! 174: if ($env{'course.'.$env{'request.course.id'}.'.languages'} ne '') {
! 175: @userlangs=(@userlangs,split(/\s*(\,|\;|\:)\s*/,
! 176: $env{'course.'.$env{'request.course.id'}.'.languages'}));
! 177: } else {
! 178: my %langhash = &getlangs($uname,$udom);
! 179: if ($langhash{'languages'} ne '') {
! 180: @userlangs = split(/\s*(\,|\;|\:)\s*/,$langhash{'languages'});
! 181: } else {
! 182: my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
! 183: if ($domdefs{'lang_def'} ne '') {
! 184: @userlangs = ($domdefs{'lang_def'});
! 185: }
! 186: }
! 187: }
! 188: if (scalar(@userlangs) == 1) {
! 189: $locale = $userlangs[0];
! 190: }
! 191: my ($title,$digest_symb);
! 192: my ($symb) = &Apache::lonnet::whichuser();
! 193: if ($symb) {
! 194: $digest_symb = &Encode::decode_utf8($symb);
! 195: $digest_symb = &Digest::SHA::sha1_hex($digest_symb);
! 196: my $navmap = Apache::lonnavmaps::navmap->new();
! 197: if (ref($navmap)) {
! 198: my $res = $navmap->getBySymb($symb);
! 199: if (ref($res)) {
! 200: $title = $res->compTitle();
! 201: }
! 202: }
! 203: }
! 204: my %ltiparams = (
! 205: lti_version => $version,
! 206: lti_message_type => $msgtype,
! 207: resource_link_title => $title,
! 208: resource_link_id => $digest_symb,
! 209: tool_consumer_instance_guid => $lonhost,
! 210: tool_consumer_info_product_family_code => 'loncapa',
! 211: tool_consumer_info_version => $loncaparev,
! 212: user_id => $digest_user,
! 213: lis_person_sourcedid => $uname.':'.$udom,
! 214: roles => $ltirole,
! 215: context_id => $env{'request.course.id'},
! 216: context_type => $context_type,
! 217: context_label => $env{'course.'.$env{'request.course.id'}.'.internal.coursecode'},
! 218: context_title => $env{'course.'.$env{'request.course.id'}.'.description'},
! 219: launch_presentation_locale => $locale,
! 220: );
! 221: my $crshostname = $env{'course.'.$env{'request.course.id'}.'.home'};
! 222: my $crsprotocol = $Apache::lonnet::protocol{$crshostname};
! 223: if ($crshostname) {
! 224: my $crsprotocol = $Apache::lonnet::protocol{$crshostname};
! 225: unless ($crsprotocol eq 'https') {
! 226: $crsprotocol = 'http';
! 227: }
! 228: if ($passback) {
! 229: if ($ltirole eq 'Learner') {
! 230: $ltiparams{'lis_outcome_service_url'} = $crsprotocol.'//'.$crshostname.'/adm/ltipassback';
! 231: $ltiparams{'ext_ims_lis_basic_outcome_url'} = $ltiparams{'lis_outcome_service_url'};
! 232: $ltiparams{'lis_result_sourcedid'} = ''; #FIXME
! 233: }
! 234: }
! 235: if ($roster) {
! 236: if (&Apache::lonnet::allowed('opa',$env{'request.course.id'})) {
! 237: $ltiparams{'ext_ims_lis_memberships_url'} = $crsprotocol.'//'.$crshostname.'/adm/ltiroster';
! 238: $ltiparams{'ext_ims_lis_memberships_id'} = ''; #FIXME
! 239: }
! 240: }
! 241: }
! 242: if ($display{'target'}) {
! 243: $ltiparams{'launch_presentation_document_target'} = $display{'target'};
! 244: }
! 245: if ($display{'width'}) {
! 246: $ltiparams{'launch_presentation_width'} = $display{'width'};
! 247: }
! 248: if ($display{'height'}) {
! 249: $ltiparams{'launch_presentation_height'} = $display{'height'};
! 250: }
! 251: if ($fields{'firstname'}) {
! 252: $ltiparams{'lis_person_name_given'} = $env{'environment.firstname'};
! 253: }
! 254: if ($fields{'lastname'}) {
! 255: $ltiparams{'lis_person_name_family'} = $env{'environment.lastname'};
! 256: }
! 257: if ($fields{'fullname'}) {
! 258: $ltiparams{'lis_person_name_full'} = &Apache::loncommon::plainname($uname,$udom);
! 259: }
! 260: if ($fields{'email'}) {
! 261: my %emails = &Apache::loncommon::getemails($uname,$udom);
! 262: my $contact_email;
! 263: foreach my $email ('permanentemail','critnotification','notification') {
! 264: if ($email =~ /\@/) {
! 265: $contact_email = $email;
! 266: last;
! 267: }
! 268: }
! 269: $ltiparams{'lis_person_contact_email_primary'} = &contact_email;
! 270: }
! 271: if (keys(%custom)) {
! 272: foreach my $key (keys(%custom)) {
! 273: $ltiparams{'custom_'.$key} = $custom{$key};
! 274: }
! 275: }
! 276: foreach my $key (keys(%ltiparams)) {
! 277: $ltiparams{$key} = &Encode::decode_utf8($ltiparams{$key});
! 278: }
! 279: return %ltiparams;
! 280: }
! 281:
! 282: sub launch_html {
! 283: my ($url,$key,$secret,$toolname,$paramsref) = @_;
! 284: my $hashref = &sign_params($url,$key,$secret,$paramsref);
! 285: my $submittext = &mt('Launch [_1]',$toolname);
! 286: my $form = <<"END";
! 287: <!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
! 288: <html xmlns="http://www.w3.org/1999/xhtml" lang="en" xml:lang="en">
! 289: <body>
! 290: <div id="LCltiLaunch">
! 291: <form name="LCltiLaunchForm" action="$url" method="post" encType="application/x-www-form-urlencoded">
! 292: <input type="submit" name="LCbasicltiSubmit" value="$submittext" />
! 293: END
! 294: if (ref($hashref) eq 'HASH') {
! 295: foreach my $item (keys(%{$hashref})) {
! 296: $form .= '<input type="hidden" name="'.$item.'" value="'.$hashref->{$item}.'" id="id_'.$item.'" />'."\n";
! 297: }
! 298: }
! 299: $form .= "</form></div>\n";
! 300: $form .= <<"ENDJS";
! 301: <script type="text/javascript">
! 302: document.getElementById("LCltiLaunch").style.display = "none";
! 303: nei = document.createElement('input');
! 304: nei.setAttribute('type','hidden');
! 305: nei.setAttribute('name','LCbasicltiSubmit');
! 306: nei.setAttribute('value','$submittext');
! 307: document.getElementById("LCltiLaunchForm").appendChild(nei);
! 308: document.LCltiLaunchForm.submit();
! 309: </script>
! 310: ENDJS
! 311: $form .= "</body></html>\n";
! 312: return $form;
! 313: }
! 314:
! 315: sub sign_params {
! 316: my ($url,$key,$secret,$paramsref) = @_;
! 317: my $nonce = Digest::SHA::sha1_hex(sprintf("%06x%06x",rand(0xfffff0),rand(0xfffff0)));
! 318: my $request = Net::OAuth->request("request token")->new(
! 319: consumer_key => $key,
! 320: consumer_secret => $secret,
! 321: request_url => $url,
! 322: request_method => 'POST',
! 323: signature_method => 'HMAC-SHA1',
! 324: timestamp => time,
! 325: nonce => $nonce,
! 326: callback => 'about:blank',
! 327: extra_params => $paramsref,
! 328: version => '1.0',
! 329: );
! 330: $request->sign;
! 331: return $request->to_hash();
! 332: }
! 333:
! 334: 1;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to lonexttool.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / interface