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