Return to ltiutils.pm CVS log

Up to [LON-CAPA] / loncom / lti

- For 2.11.2 (modified)
  Retain only those routines used to support LON-CAPA as LTI Consumer.
  Remove passback and roster options, and related routines.

    1: # The LearningOnline Network with CAPA
    2: # Utility functions for managing LON-CAPA LTI interactions 
    3: #
    4: # $Id: ltiutils.pm,v 1.9.2.1 2020/04/09 23:17:19 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: package LONCAPA::ltiutils;
   30: 
   31: use strict;
   32: use Net::OAuth;
   33: use Digest::SHA;
   34: use Apache::lonnet;
   35: use Apache::loncommon;
   36: use LONCAPA qw(:DEFAULT :match);
   37: 
   38: #
   39: # LON-CAPA as LTI Consumer
   40: #
   41: # Determine if a nonce in POSTed data has expired.
   42: # If unexpired, confirm it has not already been used.
   43: #
   44: # When LON-CAPA is operating as a Consumer, nonce checking
   45: # occurs when a Tool Provider launched from an instance of
   46: # an external tool in a LON-CAPA course makes a request to
   47: # (a) /adm/service/roster or (b) /adm/service/passback to, 
   48: # respectively, retrieve a roster or store the grade for 
   49: # the original launch by a specific user.
   50: #
   51: 
   52: sub check_nonce {
   53:     my ($nonce,$timestamp,$lifetime,$domain,$ltidir) = @_;
   54:     if (($ltidir eq '') || ($timestamp eq '') || ($timestamp =~ /^\D/) ||
   55:         ($lifetime eq '') || ($lifetime =~ /\D/) || ($domain eq '')) {
   56:         return;
   57:     }
   58:     my $now = time;
   59:     if (($timestamp) && ($timestamp < ($now - $lifetime))) {
   60:         return;
   61:     }
   62:     if ($nonce eq '') {
   63:         return;
   64:     }
   65:     if (-e "$ltidir/$domain/$nonce") {
   66:         return;
   67:     } else  {
   68:         unless (-e "$ltidir/$domain") {
   69:             unless (mkdir("$ltidir/$domain",0755)) {
   70:                 return;
   71:             }
   72:         }
   73:         if (open(my $fh,'>',"$ltidir/$domain/$nonce")) {
   74:             print $fh $now;
   75:             close($fh);
   76:             return 1;
   77:         }
   78:     }
   79:     return;
   80: }
   81: 
   82: #
   83: # LON-CAPA as LTI Consumer
   84: #
   85: # Determine the domain and the courseID of the LON-CAPA course
   86: # for which access is needed by a Tool Provider -- either to 
   87: # retrieve a roster or store the grade for an instance of an 
   88: # external tool in the course.
   89: #
   90: 
   91: sub get_loncapa_course {
   92:     my ($lonhost,$cid,$errors) = @_;
   93:     return unless (ref($errors) eq 'HASH');
   94:     my ($cdom,$cnum);
   95:     if ($cid =~ /^($match_domain)_($match_courseid)$/) {
   96:         my ($posscdom,$posscnum) = ($1,$2);
   97:         my $cprimary_id = &Apache::lonnet::domain($posscdom,'primary');
   98:         if ($cprimary_id eq '') {
   99:             $errors->{5} = 1;
  100:             return;
  101:         } else {
  102:             my @intdoms;
  103:             my $internet_names = &Apache::lonnet::get_internet_names($lonhost);
  104:             if (ref($internet_names) eq 'ARRAY') {
  105:                 @intdoms = @{$internet_names};
  106:             }
  107:             my $cintdom = &Apache::lonnet::internet_dom($cprimary_id);
  108:             if  (($cintdom ne '') && (grep(/^\Q$cintdom\E$/,@intdoms))) {
  109:                 $cdom = $posscdom;
  110:             } else {
  111:                 $errors->{6} = 1;
  112:                 return;
  113:             }
  114:         }
  115:         my $chome = &Apache::lonnet::homeserver($posscnum,$posscdom);
  116:         if ($chome =~ /(con_lost|no_host|no_such_host)/) {
  117:             $errors->{7} = 1;
  118:             return;
  119:         } else {
  120:             $cnum = $posscnum;
  121:         }
  122:     } else {
  123:         $errors->{8} = 1;
  124:         return;
  125:     }
  126:     return ($cdom,$cnum);
  127: }
  128: 
  129: #
  130: # LON-CAPA as LTI Consumer
  131: #
  132: # Determine the symb and (optionally) LON-CAPA user for an 
  133: # instance of an external tool in a course -- either to 
  134: # to retrieve a roster or store a grade.
  135: #
  136: # Use the digested symb to lookup the real symb in exttools.db
  137: # and the digested userID to lookup the real userID (if needed).
  138: # and extract the exttool instance and symb.
  139: #
  140: 
  141: sub get_tool_instance {
  142:     my ($cdom,$cnum,$digsymb,$diguser,$errors) = @_;
  143:     return unless (ref($errors) eq 'HASH');
  144:     my ($marker,$symb,$uname,$udom);
  145:     my @keys = ($digsymb); 
  146:     if ($diguser) {
  147:         push(@keys,$diguser);
  148:     }
  149:     my %digesthash = &Apache::lonnet::get('exttools',\@keys,$cdom,$cnum);
  150:     if ($digsymb) {
  151:         $symb = $digesthash{$digsymb};
  152:         if ($symb) {
  153:             my ($map,$id,$url) = split(/___/,$symb);
  154:             $marker = (split(m{/},$url))[3];
  155:             $marker=~s/\D//g;
  156:         } else {
  157:             $errors->{9} = 1;
  158:         }
  159:     }
  160:     if ($diguser) {
  161:         if ($digesthash{$diguser} =~ /^($match_username):($match_domain)$/) {
  162:             ($uname,$udom) = ($1,$2);
  163:         } else {
  164:             $errors->{10} = 1;
  165:         }
  166:         return ($marker,$symb,$uname,$udom);
  167:     } else {
  168:         return ($marker,$symb);
  169:     }
  170: }
  171: 
  172: #
  173: # LON-CAPA as LTI Consumer
  174: #
  175: # Verify a signed request using the consumer_key and
  176: # secret for the specific LTI Provider.
  177: #
  178: 
  179: sub verify_request {
  180:     my ($params,$protocol,$hostname,$requri,$reqmethod,$consumer_secret,$errors) = @_;
  181:     return unless (ref($errors) eq 'HASH');
  182:     my $request = Net::OAuth->request('request token')->from_hash($params,
  183:                                        request_url => $protocol.'://'.$hostname.$requri,
  184:                                        request_method => $reqmethod,
  185:                                        consumer_secret => $consumer_secret,);
  186:     unless ($request->verify()) {
  187:         $errors->{15} = 1;
  188:         return;
  189:     }
  190: }
  191: 
  192: #
  193: # LON-CAPA as LTI Consumer
  194: #
  195: # Sign a request used to launch an instance of an external
  196: # tool in a LON-CAPA course, using the key and secret supplied 
  197: # by the Tool Provider.
  198: # 
  199: 
  200: sub sign_params {
  201:     my ($url,$key,$secret,$sigmethod,$paramsref) = @_;
  202:     return unless (ref($paramsref) eq 'HASH');
  203:     if ($sigmethod eq '') {
  204:         $sigmethod = 'HMAC-SHA1';
  205:     }
  206:     srand( time() ^ ($$ + ($$ << 15))  ); # Seed rand.
  207:     my $nonce = Digest::SHA::sha1_hex(sprintf("%06x%06x",rand(0xfffff0),rand(0xfffff0)));
  208:     my $request = Net::OAuth->request("request token")->new(
  209:             consumer_key => $key,
  210:             consumer_secret => $secret,
  211:             request_url => $url,
  212:             request_method => 'POST',
  213:             signature_method => $sigmethod,
  214:             timestamp => time,
  215:             nonce => $nonce,
  216:             callback => 'about:blank',
  217:             extra_params => $paramsref,
  218:             version      => '1.0',
  219:             );
  220:     $request->sign;
  221:     return $request->to_hash();
  222: }
  223: 
  224: 1;