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>
![[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