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

1.1       raeburn     1: # The LearningOnline Network with CAPA
                      2: # LTI Consumer Module to respond to a course roster request.
                      3: #
1.5     ! raeburn     4: # $Id: ltiroster.pm,v 1.4 2018/08/14 21:42:36 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 Apache::ltiroster;
                     30: 
                     31: use strict;
                     32: use Apache::Constants qw(:common :http);
                     33: use Encode;
                     34: use Digest::SHA;
1.4       raeburn    35: use URI::Escape;
1.1       raeburn    36: use Apache::lonnet;
                     37: use Apache::loncommon;
                     38: use Apache::lonacc;
                     39: use Apache::loncoursedata;
                     40: use LONCAPA::ltiutils;
                     41: 
                     42: sub handler {
                     43:     my $r = shift;
                     44:     my %errors;
1.4       raeburn    45:     my $params = {};
                     46:     my ($oauthtype,$authheader);
                     47: #
                     48: # Retrieve content type from headers
                     49: #
                     50:     my $content_type = $r->headers_in->get('Content-Type');
                     51:     if ($content_type eq 'application/xml') {
                     52:         $oauthtype = 'consumer';
                     53: #
                     54: # Retrieve OAuth data sent by LTI Provider from Authorization header
                     55: #
                     56:         $authheader = $r->headers_in->get('Authorization');
                     57:         my ($authtype,$valuestr) = ($authheader =~ /^(OAuth)\s+(.+)$/i);
                     58:         if (lc($authtype) eq 'oauth') {
                     59:             foreach my $pair (split(/\s*,\s*/,$valuestr)) {
                     60:                 my ($key,$value) = split(/=/,$pair);
                     61:                 $value =~ s /(^"|"$)//g;
                     62:                 $params->{$key} = URI::Escape::uri_unescape($value);
                     63:             }
                     64:         }
                     65:     } else {
                     66:         $oauthtype = 'request token';
1.1       raeburn    67: #
                     68: # Retrieve data POSTed by LTI Provider
                     69: #
1.4       raeburn    70:         &Apache::lonacc::get_posted_cgi($r);
                     71:         foreach my $key (sort(keys(%env))) {
                     72:             if ($key =~ /^form\.(.+)$/) {
                     73:                 $params->{$1} = $env{$key};
                     74:             }
1.1       raeburn    75:         }
                     76:     }
                     77: 
                     78:     unless (keys(%{$params})) {
                     79:         $errors{1} = 1;
                     80:         &invalid_request($r,\%errors);
                     81:         return OK;
                     82:     }
                     83: 
                     84: #
                     85: # Retrieve the signature, digested symb, and LON-CAPA courseID
                     86: # from the ext_ims_lis_memberships_id in the POSTed data
                     87: #
                     88: 
                     89:     unless ($params->{'ext_ims_lis_memberships_id'}) {
                     90:         $errors{2} = 1;
                     91:         &invalid_request($r,\%errors);
                     92:         return OK;
                     93:     }
                     94: 
                     95:     my ($rostersig,$digsymb,$cid) = split(/\Q:::\E/,$params->{'ext_ims_lis_memberships_id'});
                     96:     unless ($rostersig && $digsymb && $cid) {
                     97:         $errors{3} = 1;
                     98:         &invalid_request($r,\%errors);
                     99:         return OK;
                    100:     }
                    101: 
                    102:     my ($cdom,$cnum,$marker,$symb);
                    103: 
                    104: #
                    105: # Determine the domain and the courseID of the LON-CAPA course to which the
                    106: # launch of LON-CAPA should provide access.
                    107: #
                    108:     ($cdom,$cnum) = &LONCAPA::ltiutils::get_loncapa_course($r->dir_config('lonHostID'),
                    109:                                                            $cid,\%errors);
                    110:     unless ($cdom && $cnum) {
                    111:         &invalid_request($r,\%errors);
                    112:         return OK;
                    113:     }
                    114: 
                    115: #
                    116: # Use the digested symb to lookup the real symb in exttools.db
                    117: #
                    118: 
                    119:     ($marker,$symb) = 
                    120:         &LONCAPA::ltiutils::get_tool_instance($cdom,$cnum,$digsymb,undef,\%errors);
                    121: 
                    122:     unless ($marker) {
1.2       raeburn   123:         $errors{4} = 1;
1.1       raeburn   124:         &invalid_request($r,\%errors);
                    125:         return OK;
                    126:     }
                    127: 
                    128: #
                    129: # Retrieve the Consumer key and Consumer secret from the domain configuration
                    130: # for the Tool Provider ID stored in the exttool_$marker.db
                    131: #
                    132: 
                    133:     my (%toolsettings,%ltitools);
                    134:     my ($consumer_secret,$nonce_lifetime) =
                    135:         &LONCAPA::ltiutils::get_tool_secret($params->{'oauth_consumer_key'},
                    136:                                             $marker,$symb,$cdom,$cnum,
                    137:                                             \%toolsettings,\%ltitools,\%errors);
                    138: 
                    139: #
                    140: # Verify the signed request using the consumer_key and
                    141: # secret for the specific LTI Provider.
                    142: #
                    143: 
                    144:     my $protocol = 'http';
                    145:     if ($ENV{'SERVER_PORT'} == 443) {
                    146:         $protocol = 'https';
                    147:     }
1.5     ! raeburn   148:     unless (LONCAPA::ltiutils::verify_request($oauthtype,$protocol,$r->hostname,$r->uri,
1.1       raeburn   149:                                               $env{'request.method'},$consumer_secret,
1.4       raeburn   150:                                               $params,$authheader,\%errors)) {
1.1       raeburn   151:         &invalid_request($r,\%errors);
                    152:         return OK;
                    153:     }
                    154: 
                    155: #
                    156: # Determine if nonce in POSTed data has expired.
                    157: # If unexpired, confirm it has not already been used.
                    158: 
                    159:     unless (&LONCAPA::ltiutils::check_nonce($params->{'oauth_nonce'},$params->{'oauth_timestamp'},
                    160:                                             $nonce_lifetime,$cdom,$r->dir_config('lonLTIDir'))) {
1.2       raeburn   161:         $errors{16} = 1;
1.1       raeburn   162:         &invalid_request($r,\%errors);
                    163:         return OK;
                    164:     }
                    165: 
                    166: #
                    167: # Verify that the ext_ims_lis_memberships_id has not been tampered
                    168: # with, and the rostersecret used to create it is still valid.
                    169: #
                    170: 
                    171:     unless (&LONCAPA::ltiutils::verify_lis_item($rostersig,'roster',$digsymb,undef,$cdom,$cnum,
                    172:                                                 \%toolsettings,\%ltitools,\%errors)) {
                    173:         &invalid_request($r,\%errors);
                    174:         return OK;
                    175:     }
                    176: 
                    177: #
                    178: #  Retrieve users with active roles in course for all roles for which roles have been mapped
                    179: #  in domain configuration for the Tool Provider requesting the roster. 
                    180: #
                    181:     my %maproles;
                    182: 
                    183:     if (ref($ltitools{'roles'}) eq 'HASH') {
                    184:         %maproles = %{$ltitools{'roles'}}; 
                    185:     }
                    186: 
                    187:     unless (keys(%maproles)) {
1.2       raeburn   188:         $errors{21} = 1; 
1.1       raeburn   189:         &invalid_request($r,\%errors);
                    190:         return OK;
                    191:     }
                    192: 
                    193:     my $crstype;
                    194:     my @allroles = &Apache::lonuserutils::roles_by_context('course',0,$crstype);
                    195: 
                    196:     my (%availableroles,$coursepersonnel,$includestudents,%userdata,
                    197:         @needpersenv,@needstuenv,$needemail,$needfullname,$needuser,
                    198:         $needroles,$needsresult,$gradesecret);
                    199: 
                    200:     if ($ltitools{'passback'}) {
                    201:         my $now = time;
                    202:         if (&LONCAPA::ltiutils::set_service_secret($cdom,$cnum,$marker,'grade',$now,
                    203:                                                     \%toolsettings,\%ltitools) eq 'ok') {
                    204:             if ($toolsettings{'gradesecret'} ne '') {
                    205:                 $needsresult = 1;
1.3       raeburn   206:                 $gradesecret = $toolsettings{'gradesecret'};
1.1       raeburn   207:             }
                    208:         }
                    209:     }
                    210: 
                    211:     foreach my $role (@allroles) {
                    212:         if (exists($maproles{$role})) {
                    213:             $availableroles{$role} = 1;
                    214:             if ($role eq 'st') {
                    215:                 $includestudents = 1;
                    216:             } else {
                    217:                 $coursepersonnel = 1;
                    218:             }
                    219:         }
                    220:     }
                    221:     if (keys(%availableroles)) {
                    222:         $needroles = 1;
                    223:     }
                    224:     if (ref($ltitools{'fields'}) eq 'HASH') {
                    225:         foreach my $field (keys(%{$ltitools{'fields'}})) {
                    226:             if (($field eq 'lastname') || ($field eq 'firstname')) {
                    227:                 push(@needstuenv,$field); 
                    228:                 push(@needpersenv,$field);
                    229:             } elsif ($field eq 'email') {
                    230:                 $needemail = 1;
                    231:                 push(@needpersenv,'permanentemail');
                    232:             } elsif ($field eq 'fullname') {
                    233:                 $needfullname = 1;
                    234:             } elsif ($field eq 'user') {
                    235:                 $needuser = 1;
                    236:             }
                    237:         }
                    238:     }
                    239: 
                    240:     my $statusidx = &Apache::loncoursedata::CL_STATUS();
                    241:     my $emailidx = &Apache::loncoursedata::CL_PERMANENTEMAIL();
                    242: 
                    243:     my %students;
                    244:     if ($includestudents) {
                    245:         my $classlist = &Apache::loncoursedata::get_classlist($cdom,$cnum);
                    246:         if (ref($classlist) eq 'HASH') {
                    247:             %students = %{$classlist};
                    248:         }
                    249:     }
                    250: 
                    251:     &Apache::loncommon::content_type($r,'text/xml');
                    252:     $r->send_http_header;
                    253:     if ($r->header_only) {
                    254:         return;
                    255:     }
                    256:     $r->print(<<"END");
                    257: <message_response>
                    258:   <lti_message_type>basic-lis-readmembershipsforcontext</lti_message_type>
                    259:   <statusinfo>
                    260:     <codemajor>Success</codemajor>
                    261:     <severity>Status</severity>
                    262:     <codeminor>fullsuccess</codeminor>
                    263:     <description>Roster retrieved</description>
                    264:   </statusinfo>
                    265:   <memberships>
                    266: END
                    267: 
                    268:     my %skipstu;
                    269:     if ($coursepersonnel) {
                    270:         my %personnel = &Apache::lonnet::get_my_roles($cnum,$cdom);
                    271:         foreach my $key (sort(keys(%personnel))) {
                    272:             my ($uname,$udom,$role) = split(/:/,$key);
                    273:             if ($availableroles{$role}) {
                    274:                 $userdata{$uname.':'.$udom}{'ltiroles'}{$maproles{$role}} = 1;
                    275:             }
                    276:         }
                    277:         foreach my $user (sort(keys(%userdata))) {
                    278:             if (exists($students{$user})) {
                    279:                 $skipstu{$user} = 1;
                    280:             }
                    281:             $r->print("    <member>\n");
                    282:             my ($uname,$udom) = split(/:/,$user);
                    283:             my $digest_user = &Encode::decode_utf8($uname.':'.$udom);
                    284:             $digest_user = &Digest::SHA::sha1_hex($digest_user);
                    285:             $r->print('      <user_id>'.$digest_user.'</user_id>'."\n");
                    286:             if (exists($students{$user})) {
                    287:                 if (ref($students{$user}) eq 'ARRAY') {
                    288:                     if ($students{$user}[$statusidx] eq 'Active') {
                    289:                         $userdata{$uname.':'.$udom}{'ltiroles'}{$maproles{'st'}} = 1;
                    290:                     }
                    291:                 }
                    292:             }
                    293:             if ($needroles) {
                    294:                 if (ref($userdata{$uname.':'.$udom}{'ltiroles'}) eq 'HASH') {
                    295:                     $r->print('      <roles>'.join(',',sort(keys(%{$userdata{$uname.':'.$udom}{'ltiroles'}}))).'</roles>'."\n");
                    296:                 } else {
                    297:                     $r->print("      <roles></roles>\n");
                    298:                 }
                    299:             } else {
                    300:                 $r->print("      <roles></roles>\n");
                    301:             }
                    302:             if ($needuser) {
                    303:                 $r->print('      <person_sourcedid>'.$user.'</person_sourcedid>'."\n");
                    304:             } else {
                    305:                 $r->print("      <person_sourcedid></person_sourcedid>\n");
                    306:             }
                    307:             my %userinfo;
                    308:             if (@needpersenv) {
                    309:                 %userinfo = &Apache::lonnet::userenvironment($udom,$uname,@needpersenv);
                    310:             }
                    311:             foreach my $item ('firstname','lastname','permanentemail') {
                    312:                 my $info;
                    313:                 if ((@needpersenv) && (grep(/^\Q$item\E$/,@needpersenv))) {
                    314:                     $info = $userinfo{$item};
                    315:                 }
                    316:                 if ($item eq 'firstname') {
                    317:                     $r->print('      <person_name_given>'.$info.'</person_name_given>'."\n");
                    318:                 } elsif ($item eq 'lastname') {
                    319:                     $r->print('      <person_name_family>'.$info.'</person_name_family>'."\n");
                    320:                 } elsif ($item eq 'permanentemail') {
                    321:                     $r->print('      <person_contact_email_primary>'.$info.'</person_contact_email_primary>'."\n");
                    322:                 }
                    323:             }
                    324:             if ($needfullname) {
                    325:                 my $info = &Apache::loncommon::plainname($uname,$udom);
                    326:                 if ($info eq $uname.':'.$udom) {
                    327:                     $info = '';    
                    328:                 }
                    329:                 $r->print('      <person_name_full>'.$info.'</person_name_full>'."\n");
                    330:             } else {
                    331:                 $r->print('      <person_name_full></person_name_full>'."\n");
                    332:             }
                    333:             if ($needsresult) {
                    334:                 my $uniqid = $digsymb.':::'.$digest_user.':::'.$cid;
                    335:                 my $sourcedid = &LONCAPA::ltiutils::get_service_id($gradesecret,$uniqid);
                    336:                 $r->print('      <lis_result_sourcedid>'.$sourcedid.'</lis_result_sourcedid>'."\n");
                    337:             } else {
                    338:                 $r->print("      <lis_result_sourcedid></lis_result_sourcedid>\n");
                    339:             }
                    340:             $r->print("    </member>\n");
                    341:         }
                    342:     }
                    343: 
                    344:     if (($includestudents) && (keys(%students))) {
                    345:         foreach my $user (keys(%students)) {
                    346:             next if ($skipstu{$user});
                    347:             if (ref($students{$user}) eq 'ARRAY') {
                    348:                 next unless ($students{$user}[$statusidx] eq 'Active');
                    349:                 $r->print("    <member>\n");
                    350:                 my ($uname,$udom) = split(/:/,$user);
                    351:                 my $digest_user = &Encode::decode_utf8($uname.':'.$udom);
                    352:                 $digest_user = &Digest::SHA::sha1_hex($digest_user);
                    353:                 $r->print('      <user_id>'.$digest_user.'</user_id>'."\n");
                    354:                 if ($needroles) {
                    355:                     $r->print('      <roles>'.$maproles{'st'}.'</roles>'."\n");
                    356:                 } else {
                    357:                     $r->print("      <roles></roles>\n");
                    358:                 }
                    359:                 if ($needuser) {
                    360:                     $r->print('      <person_sourcedid>'.$user.'</person_sourcedid>'."\n");
                    361:                 } else {
                    362:                     $r->print("      <person_sourcedid></person_sourcedid>\n");
                    363:                 }
                    364:                 my %userinfo;
                    365:                 if (@needstuenv) {
                    366:                     %userinfo = &Apache::lonnet::userenvironment($udom,$uname,@needstuenv);
                    367:                 }
                    368:                 foreach my $item ('firstname','lastname') {
                    369:                     my $info;
                    370:                     if ((@needstuenv) && (grep(/^\Q$item\E$/,@needstuenv))) {
                    371:                         $info = $userinfo{$item};
                    372:                     }
                    373:                     if ($item eq 'firstname') {
                    374:                         $r->print('      <person_name_given>'.$info.'</person_name_given>'."\n");
                    375:                     } elsif ($item eq 'lastname') {
                    376:                         $r->print('      <person_name_family>'.$info.'</person_name_family>'."\n");
                    377:                     }
                    378:                 }
                    379:                 if ($needemail) {
                    380:                     $r->print('      <person_contact_email_primary>'.$students{$user}[$emailidx].'</person_contact_email_primary>'."\n");
                    381:                 } else {
                    382:                     $r->print('      <person_contact_email_primary></person_contact_email_primary>'."\n"); 
                    383:                 }
                    384:                 if ($needfullname) {
                    385:                     my $info = &Apache::loncommon::plainname($uname,$udom);
                    386:                     if ($info eq $uname.':'.$udom) {
                    387:                         $info = '';
                    388:                     }
                    389:                     $r->print('      <person_name_full>'.$info.'</person_name_full>'."\n");
                    390:                 } else {
                    391:                     $r->print('      <person_name_full></person_name_full>'."\n");
                    392:                 }
                    393:                 if ($needsresult) {
                    394:                     my $uniqid = $digsymb.':::'.$digest_user.':::'.$cid;
                    395:                     my $sourcedid = &LONCAPA::ltiutils::get_service_id($gradesecret,$uniqid);
                    396:                     $r->print('      <lis_result_sourcedid>'.$sourcedid.'</lis_result_sourcedid>'."\n");
                    397:                 } else {
                    398:                     $r->print("      <lis_result_sourcedid></lis_result_sourcedid>\n");
                    399:                 }
                    400:                 $r->print("    </member>\n");
                    401:             }
                    402:         }
                    403:     }
                    404:     $r->print(<<"END");
                    405:   </memberships>
                    406: </message_response>
                    407: END
                    408:     return OK;
                    409: }
                    410: 
                    411: sub invalid_request {
                    412:     my ($r,$errors) = @_;
                    413:     my $errormsg;
                    414:     if (ref($errors) eq 'HASH') {
1.2       raeburn   415:         $errormsg = join(',',keys(%{$errors}));
1.1       raeburn   416:     }
                    417:     &Apache::loncommon::content_type($r,'text/xml');
                    418:     $r->send_http_header;
                    419:     if ($r->header_only) {
                    420:         return;
                    421:     }
                    422:     $r->print(<<"END");
                    423: <message_response>
                    424:   <lti_message_type>basic-lis-updateresult</lti_message_type>
                    425:   <statusinfo>
                    426:      <codemajor>Failure</codemajor>
                    427:      <severity>Error</severity>
                    428:      <codeminor>$errormsg</codeminor>
                    429:   </statusinfo>
                    430: </message_response>
                    431: END
                    432:     return;
                    433: }
                    434: 
                    435: 1;

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