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