Annotation of loncom/lti/ltiutils.pm, revision 1.5

1.1       raeburn     1: # The LearningOnline Network with CAPA
                      2: # Utility functions for managing LON-CAPA LTI interactions 
                      3: #
1.5     ! raeburn     4: # $Id: ltiutils.pm,v 1.4 2018/01/04 12:09:42 raeburn Exp $
1.1       raeburn     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 UUID::Tiny ':std';
                     35: use Apache::lonnet;
                     36: use Apache::loncommon;
                     37: use LONCAPA qw(:DEFAULT :match);
                     38: 
                     39: #
                     40: # LON-CAPA as LTI Consumer or LTI Provider
                     41: #
                     42: # Determine if a nonce in POSTed data has expired.
                     43: # If unexpired, confirm it has not already been used.
                     44: #
                     45: # When LON-CAPA is operating as a Consumer, nonce checking
                     46: # occurs when a Tool Provider launched from an instance of
                     47: # an external tool in a LON-CAPA course makes a request to
                     48: # (a) /adm/service/roster or (b) /adm/service/passback to, 
                     49: # respectively, retrieve a roster or store the grade for 
                     50: # the original launch by a specific user.
                     51: #
                     52: # When LON-CAPA is operating as a Provider, nonce checking 
                     53: # occurs when a user in course context in another LMS (the 
1.4       raeburn    54: # Consumer) launches an external tool to access a LON-CAPA URL: 
1.1       raeburn    55: # /adm/lti/ with LON-CAPA symb, map, or deep-link ID appended.
                     56: #
                     57: 
                     58: sub check_nonce {
                     59:     my ($nonce,$timestamp,$lifetime,$domain,$ltidir) = @_;
                     60:     if (($ltidir eq '') || ($timestamp eq '') || ($timestamp =~ /^\D/) ||
                     61:         ($lifetime eq '') || ($lifetime =~ /\D/) || ($domain eq '')) {
                     62:         return;
                     63:     }
                     64:     my $now = time;
                     65:     if (($timestamp) && ($timestamp < ($now - $lifetime))) {
                     66:         return;
                     67:     }
                     68:     if ($nonce eq '') {
                     69:         return;
                     70:     }
                     71:     if (-e "$ltidir/$domain/$nonce") {
                     72:         return;
                     73:     } else  {
                     74:         unless (-e "$ltidir/$domain") {
                     75:             unless (mkdir("$ltidir/$domain",0755)) {
                     76:                 return;
                     77:             }
                     78:         }
                     79:         if (open(my $fh,'>',"$ltidir/$domain/$nonce")) {
                     80:             print $fh $now;
                     81:             close($fh);
                     82:             return 1;
                     83:         }
                     84:     }
                     85:     return;
                     86: }
                     87: 
                     88: #
                     89: # LON-CAPA as LTI Consumer
                     90: #
                     91: # Determine the domain and the courseID of the LON-CAPA course
                     92: # for which access is needed by a Tool Provider -- either to 
                     93: # retrieve a roster or store the grade for an instance of an 
                     94: # external tool in the course.
                     95: #
                     96: 
                     97: sub get_loncapa_course {
                     98:     my ($lonhost,$cid,$errors) = @_;
                     99:     return unless (ref($errors) eq 'HASH');
                    100:     my ($cdom,$cnum);
                    101:     if ($cid =~ /^($match_domain)_($match_courseid)$/) {
                    102:         my ($posscdom,$posscnum) = ($1,$2);
                    103:         my $cprimary_id = &Apache::lonnet::domain($posscdom,'primary');
                    104:         if ($cprimary_id eq '') {
                    105:             $errors->{5} = 1;
                    106:             return;
                    107:         } else {
                    108:             my @intdoms;
                    109:             my $internet_names = &Apache::lonnet::get_internet_names($lonhost);
                    110:             if (ref($internet_names) eq 'ARRAY') {
                    111:                 @intdoms = @{$internet_names};
                    112:             }
                    113:             my $cintdom = &Apache::lonnet::internet_dom($cprimary_id);
                    114:             if  (($cintdom ne '') && (grep(/^\Q$cintdom\E$/,@intdoms))) {
                    115:                 $cdom = $posscdom;
                    116:             } else {
                    117:                 $errors->{6} = 1;
                    118:                 return;
                    119:             }
                    120:         }
                    121:         my $chome = &Apache::lonnet::homeserver($posscnum,$posscdom);
                    122:         if ($chome =~ /(con_lost|no_host|no_such_host)/) {
                    123:             $errors->{7} = 1;
                    124:             return;
                    125:         } else {
                    126:             $cnum = $posscnum;
                    127:         }
                    128:     } else {
                    129:         $errors->{8} = 1;
                    130:         return;
                    131:     }
                    132:     return ($cdom,$cnum);
                    133: }
                    134: 
                    135: #
                    136: # LON-CAPA as LTI Consumer
                    137: #
                    138: # Determine the symb and (optionally) LON-CAPA user for an 
                    139: # instance of an external tool in a course -- either to 
                    140: # to retrieve a roster or store a grade.
                    141: #
                    142: # Use the digested symb to lookup the real symb in exttools.db
                    143: # and the digested userID to lookup the real userID (if needed).
                    144: # and extract the exttool instance and symb.
                    145: #
                    146: 
                    147: sub get_tool_instance {
                    148:     my ($cdom,$cnum,$digsymb,$diguser,$errors) = @_;
                    149:     return unless (ref($errors) eq 'HASH');
                    150:     my ($marker,$symb,$uname,$udom);
                    151:     my @keys = ($digsymb); 
                    152:     if ($diguser) {
                    153:         push(@keys,$diguser);
                    154:     }
                    155:     my %digesthash = &Apache::lonnet::get('exttools',\@keys,$cdom,$cnum);
                    156:     if ($digsymb) {
                    157:         $symb = $digesthash{$digsymb};
                    158:         if ($symb) {
                    159:             my ($map,$id,$url) = split(/___/,$symb);
                    160:             $marker = (split(m{/},$url))[3];
                    161:             $marker=~s/\D//g;
                    162:         } else {
                    163:             $errors->{9} = 1;
                    164:         }
                    165:     }
                    166:     if ($diguser) {
                    167:         if ($digesthash{$diguser} =~ /^($match_username):($match_domain)$/) {
                    168:             ($uname,$udom) = ($1,$2);
                    169:         } else {
                    170:             $errors->{10} = 1;
                    171:         }
                    172:         return ($marker,$symb,$uname,$udom);
                    173:     } else {
                    174:         return ($marker,$symb);
                    175:     }
                    176: }
                    177: 
                    178: #
                    179: # LON-CAPA as LTI Consumer
                    180: #
                    181: # Retrieve data needed to validate a request from a Tool Provider
                    182: # for a roster or to store a grade for an instance of an external 
                    183: # tool in a LON-CAPA course.
                    184: #
                    185: # Retrieve the Consumer key and Consumer secret from the domain 
                    186: # configuration or the Tool Provider ID stored in the
                    187: # exttool_$marker db file and compare the Consumer key with the
                    188: # one in the POSTed data.
                    189: #
                    190: # Side effect is to populate the $toolsettings hashref with the 
                    191: # contents of the .db file (instance of tool in course) and the
                    192: # $ltitools hashref with the configuration for the tool (at
                    193: # domain level).
                    194: #
                    195: 
                    196: sub get_tool_secret {
                    197:     my ($key,$marker,$symb,$cdom,$cnum,$toolsettings,$ltitools,$errors) = @_;
                    198:     return unless ((ref($toolsettings) eq 'HASH') && (ref($ltitools) eq 'HASH') &&
                    199:                    (ref($errors) eq 'HASH'));
                    200:     my ($consumer_secret,$nonce_lifetime);
                    201:     if ($marker) {
                    202:         %{$toolsettings}=&Apache::lonnet::dump('exttool_'.$marker,$cdom,$cnum);
                    203:         if ($toolsettings->{'id'}) {
                    204:             my $idx = $toolsettings->{'id'};
                    205:             my %lti = &Apache::lonnet::get_domain_lti($cdom,'consumer');
                    206:             if (ref($lti{$idx}) eq 'HASH') {
                    207:                 %{$ltitools} = %{$lti{$idx}};
                    208:                 if ($ltitools->{'key'} eq $key) {
                    209:                     $consumer_secret = $ltitools->{'secret'};
                    210:                     $nonce_lifetime = $ltitools->{'lifetime'};
                    211:                 } else {
                    212:                     $errors->{11} = 1;
                    213:                     return;
                    214:                 }
                    215:             } else {
                    216:                 $errors->{12} = 1;
                    217:                 return;
                    218:             }
                    219:         } else {
                    220:             $errors->{13} = 1;
                    221:             return;
                    222:         }
                    223:     } else {
                    224:         $errors->{14};
                    225:         return;
                    226:     }
                    227:     return ($consumer_secret,$nonce_lifetime);
                    228: }
                    229: 
                    230: #
                    231: # LON-CAPA as LTI Consumer
                    232: #
                    233: # Verify a signed request using the consumer_key and
                    234: # secret for the specific LTI Provider.
                    235: #
                    236: 
                    237: sub verify_request {
                    238:     my ($params,$protocol,$hostname,$requri,$reqmethod,$consumer_secret,$errors) = @_;
                    239:     return unless (ref($errors) eq 'HASH');
                    240:     my $request = Net::OAuth->request('request token')->from_hash($params,
                    241:                                        request_url => $protocol.'://'.$hostname.$requri,
                    242:                                        request_method => $reqmethod,
                    243:                                        consumer_secret => $consumer_secret,);
                    244:     unless ($request->verify()) {
                    245:         $errors->{15} = 1;
                    246:         return;
                    247:     }
                    248: }
                    249: 
                    250: #
                    251: # LON-CAPA as LTI Consumer
                    252: #
                    253: # Verify that an item identifier (either roster request:
                    254: # ext_ims_lis_memberships_id, or grade store:
                    255: # lis_result_sourcedid) has not been tampered with, and
                    256: # the secret used to create the unique identifier has not
                    257: # expired.
                    258: #
                    259: # Prepending the current secret (if still valid),
                    260: # or the previous secret (if current one is no longer valid),
                    261: # to a string composed of the :::-separated components
                    262: # must generate the result signature in the lis item ID
                    263: # sent by the Tool Provider.
                    264: #
                    265: 
                    266: sub verify_lis_item {
                    267:     my ($sigrec,$context,$digsymb,$diguser,$cdom,$cnum,$toolsettings,$ltitools,$errors) = @_;
                    268:     return unless ((ref($toolsettings) eq 'HASH') && (ref($ltitools) eq 'HASH') && 
                    269:                    (ref($errors) eq 'HASH'));
                    270:     my ($has_action, $valid_for);
                    271:     if ($context eq 'grade') {
                    272:         $has_action = $ltitools->{'passback'};
                    273:         $valid_for = $ltitools->{'passbackvalid'}
                    274:     } elsif ($context eq 'roster') {
                    275:         $has_action = $ltitools->{'roster'};
                    276:         $valid_for = $ltitools->{'rostervalid'};
                    277:     }
                    278:     if ($has_action) {
                    279:         my $secret;
                    280:         if (($toolsettings->{$context.'secretdate'} + $valid_for) > time) {
                    281:             $secret = $toolsettings->{$context.'secret'};
                    282:         } else {
                    283:             $secret = $toolsettings->{'old'.$context.'secret'};
                    284:         }
                    285:         if ($secret) {
                    286:             my $expected_sig;
                    287:             if ($context eq 'grade') {
                    288:                 my $uniqid = $digsymb.':::'.$diguser.':::'.$cdom.'_'.$cnum;
1.5     ! raeburn   289:                 $expected_sig = (split(/:::/,&get_service_id($secret,$uniqid)))[0]; 
1.1       raeburn   290:                 if ($expected_sig eq $sigrec) {
                    291:                     return 1;
                    292:                 } else {
1.2       raeburn   293:                     $errors->{17} = 1;
1.1       raeburn   294:                 }
                    295:             } elsif ($context eq 'roster') {
                    296:                 my $uniqid = $digsymb.':::'.$cdom.'_'.$cnum;
1.5     ! raeburn   297:                 $expected_sig = (split(/:::/,&get_service_id($secret,$uniqid)))[0]; 
1.1       raeburn   298:                 if ($expected_sig eq $sigrec) {
                    299:                     return 1;
                    300:                 } else {
1.2       raeburn   301:                     $errors->{18} = 1;
1.1       raeburn   302:                 }
                    303:             }
                    304:         } else {
1.2       raeburn   305:             $errors->{19} = 1;
1.1       raeburn   306:         }
                    307:     } else {
1.2       raeburn   308:         $errors->{20} = 1;
1.1       raeburn   309:     }
                    310:     return;
                    311: }
                    312: 
                    313: #
                    314: # LON-CAPA as LTI Consumer
                    315: #
                    316: # Sign a request used to launch an instance of an external
1.4       raeburn   317: # tool in a LON-CAPA course, using the key and secret supplied 
1.1       raeburn   318: # by the Tool Provider.
                    319: # 
                    320: 
                    321: sub sign_params {
1.3       raeburn   322:     my ($url,$key,$secret,$sigmethod,$paramsref) = @_;
1.1       raeburn   323:     return unless (ref($paramsref) eq 'HASH');
1.3       raeburn   324:     if ($sigmethod eq '') {
                    325:         $sigmethod = 'HMAC-SHA1';
                    326:     }
1.1       raeburn   327:     my $nonce = Digest::SHA::sha1_hex(sprintf("%06x%06x",rand(0xfffff0),rand(0xfffff0)));
                    328:     my $request = Net::OAuth->request("request token")->new(
                    329:             consumer_key => $key,
                    330:             consumer_secret => $secret,
                    331:             request_url => $url,
                    332:             request_method => 'POST',
1.3       raeburn   333:             signature_method => $sigmethod,
1.1       raeburn   334:             timestamp => time,
                    335:             nonce => $nonce,
                    336:             callback => 'about:blank',
                    337:             extra_params => $paramsref,
                    338:             version      => '1.0',
                    339:             );
                    340:     $request->sign;
                    341:     return $request->to_hash();
                    342: }
                    343: 
                    344: #
                    345: # LON-CAPA as LTI Consumer
                    346: #
                    347: # Generate a signature for a unique identifier (roster request:
                    348: # ext_ims_lis_memberships_id, or grade store: lis_result_sourcedid)
                    349: #
                    350: 
                    351: sub get_service_id {
                    352:     my ($secret,$id) = @_;
                    353:     my $sig = Digest::SHA::sha1_hex($secret.':::'.$id);
                    354:     return $sig.':::'.$id;
                    355: }
                    356: 
                    357: #
                    358: # LON-CAPA as LTI Consumer
                    359: #
                    360: # Generate and store the time-limited secret used to create the
                    361: # signature in a service request identifier (roster request or
                    362: # grade store). An existing secret past its expiration date
                    363: # will be stored as old<service name>secret, and a new secret
                    364: # <service name>secret will be stored.
                    365: # 
                    366: # Secrets are specific to service name and to the tool instance 
                    367: # (and are stored in the exttool_$marker db file).
                    368: # The time period a secret remains valid is determined by the 
                    369: # domain configuration for the specific tool and the service.
                    370: # 
                    371: 
                    372: sub set_service_secret {
                    373:     my ($cdom,$cnum,$marker,$name,$now,$toolsettings,$ltitools) = @_;
                    374:     return unless ((ref($toolsettings) eq 'HASH') && (ref($ltitools) eq 'HASH'));
                    375:     my $warning;
                    376:     my ($needsnew,$oldsecret,$lifetime);
                    377:     if ($name eq 'grade') {
                    378:         $lifetime = $ltitools->{'passbackvalid'}
                    379:     } elsif ($name eq 'roster') {
                    380:         $lifetime = $ltitools->{'rostervalid'};
                    381:     }
                    382:     if ($toolsettings->{$name} eq '') {
                    383:         $needsnew = 1;
                    384:     } elsif (($toolsettings->{$name.'date'} + $lifetime) < $now) {
                    385:         $oldsecret = $toolsettings->{$name.'secret'};
                    386:         $needsnew = 1;
                    387:     }
                    388:     if ($needsnew) {
                    389:         if (&get_tool_lock($cdom,$cnum,$marker,$name,$now) eq 'ok') {
                    390:             my $secret = UUID::Tiny::create_uuid_as_string(UUID_V4);
                    391:             $toolsettings->{$name.'secret'} = $secret;
                    392:             my %secrethash = (
                    393:                            $name.'secret' => $secret,
                    394:                            $name.'secretdate' => $now,
                    395:                           );
                    396:             if ($oldsecret ne '') {
                    397:                 $secrethash{'old'.$name.'secret'} = $oldsecret;
                    398:             }
                    399:             my $putres = &Apache::lonnet::put('exttool_'.$marker,
                    400:                                               \%secrethash,$cdom,$cnum);
                    401:             my $delresult = &release_tool_lock($cdom,$cnum,$marker,$name);
                    402:             if ($delresult ne 'ok') {
                    403:                 $warning = $delresult ;
                    404:             }
                    405:             if ($putres eq 'ok') {
                    406:                 return 'ok';
                    407:             }
                    408:         } else {
                    409:             $warning = 'Could not obtain exclusive lock';
                    410:         }
                    411:     } else {
                    412:         return 'ok';
                    413:     }
                    414:     return;
                    415: }
                    416: 
                    417: #
                    418: # LON-CAPA as LTI Consumer
                    419: #
                    420: # Add a lock key to exttools.db for the instance of an external tool 
                    421: # when generating and storing a service secret.
                    422: #
                    423: 
                    424: sub get_tool_lock {
                    425:     my ($cdom,$cnum,$marker,$name,$now) = @_;
                    426:     # get lock for tool for which secret is being set
                    427:     my $lockhash = {
                    428:                      $name."\0".$marker."\0".'lock' => $now.':'.$env{'user.name'}.
                    429:                                                        ':'.$env{'user.domain'},
                    430:                    };
                    431:     my $tries = 0;
                    432:     my $gotlock = &Apache::lonnet::newput('exttools',$lockhash,$cdom,$cnum);
                    433: 
                    434:     while (($gotlock ne 'ok') && $tries <3) {
                    435:         $tries ++;
                    436:         sleep(1);
                    437:         $gotlock = &Apache::lonnet::newput('exttools',$lockhash,$cdom,$cnum);
                    438:     }
                    439:     return $gotlock;
                    440: }
                    441: 
                    442: #
                    443: # LON-CAPA as LTI Consumer
                    444: #
                    445: # Remove a lock key from exttools.db for the instance of an external
                    446: # tool created when generating and storing a service secret.
                    447: #
                    448: 
                    449: sub release_tool_lock {
1.3       raeburn   450:     my ($cdom,$cnum,$marker,$name) = @_;
1.1       raeburn   451:     #  remove lock
                    452:     my @del_lock = ($name."\0".$marker."\0".'lock');
                    453:     my $dellockoutcome=&Apache::lonnet::del('exttools',\@del_lock,$cdom,$cnum);
                    454:     if ($dellockoutcome ne 'ok') {
                    455:         return 'Warning: failed to release lock for exttool';
                    456:     } else {
                    457:         return 'ok';
                    458:     }
                    459: }
                    460: 
                    461: 1;

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>