Annotation of loncom/lti/ltipassback.pm, revision 1.5
1.1 raeburn 1: # The LearningOnline Network with CAPA
2: # LTI Consumer Module to receive grades passed back by Provider
3: #
1.5 ! raeburn 4: # $Id: ltipassback.pm,v 1.4 2017/12/12 02:13:21 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::ltipassback;
30:
31: use strict;
32: use Apache::Constants qw(:common :http);
33: use Apache::lonnet;
34: use Apache::loncommon;
35: use Apache::lonacc;
36: use LONCAPA::ltiutils;
37:
38: sub handler {
39: my $r = shift;
40: my %errors;
41: #
42: # Retrieve data POSTed by LTI Provider
43: #
44: &Apache::lonacc::get_posted_cgi($r);
45: my $params = {};
46: foreach my $key (sort(keys(%env))) {
47: if ($key =~ /^form\.(.+)$/) {
48: $params->{$1} = $env{$key};
49: }
50: }
51:
52: unless (keys(%{$params})) {
53: $errors{1} = 1;
54: &invalid_request($r,$params,\%errors);
55: return OK;
56: }
57:
58: unless ($params->{'oauth_consumer_key'} &&
59: $params->{'oauth_nonce'} &&
60: $params->{'oauth_timestamp'} &&
61: $params->{'oauth_version'} &&
62: $params->{'oauth_signature'} &&
63: $params->{'oauth_signature_method'}) {
64: $errors{2} = 1;
65: &invalid_request($r,$params,\%errors);
66: return OK;
67: }
68:
69: #
70: # Retrieve the signature, digested symb, digested user, and LON-CAPA
71: # courseID from the sourcedid in the POSTed data
72: #
73: unless ($params->{'sourcedid'}) {
74: $errors{3} = 1;
75: &invalid_request($r,$params,\%errors);
76: return OK;
77: }
78:
79: my ($resultsig,$digsymb,$diguser,$cid) = split(/\Q:::\E/,$params->{'sourcedid'});
80: unless ($resultsig && $digsymb && $diguser && $cid) {
81: $errors{4} = 1;
82: &invalid_request($r,$params,\%errors);
83: return OK;
84: }
85:
86: my ($cdom,$cnum,$marker,$symb,$uname,$udom);
87:
88: #
89: # Determine the domain and the courseID of the LON-CAPA course to which the
90: # launch of LON-CAPA should provide access.
91: #
92: ($cdom,$cnum) = &LONCAPA::ltiutils::get_loncapa_course($r->dir_config('lonHostID'),
93: $cid,\%errors);
94: unless ($cdom && $cnum) {
95: &invalid_request($r,$params,\%errors);
96: return OK;
97: }
98:
99: #
100: # Use the digested symb to lookup the real symb in exttools.db
101: #
102:
103: ($marker,$symb,$uname,$udom) =
104: &LONCAPA::ltiutils::get_tool_instance($cdom,$cnum,$digsymb,$diguser,\%errors);
105:
106: unless ($marker) {
107: &invalid_request($r,$params,\%errors);
108: return OK;
109: }
110:
111: #
112: # Retrieve the Consumer key and Consumer secret from the domain configuration
113: # for the Tool Provider ID stored in the exttool_$marker.db
114: #
115:
116: my (%toolsettings,%ltitools);
117: my ($consumer_secret,$nonce_lifetime) =
118: &LONCAPA::ltiutils::get_tool_secret($params->{'oauth_consumer_key'},
119: $marker,$symb,$cdom,$cnum,
120: \%toolsettings,\%ltitools,\%errors);
121:
122: #
123: # Verify the signed request using the consumer_key and
124: # secret for the specific LTI Provider.
125: #
126:
127: my $protocol = 'http';
128: if ($ENV{'SERVER_PORT'} == 443) {
129: $protocol = 'https';
130: }
131: unless (LONCAPA::ltiutils::verify_request($params,$protocol,$r->hostname,$r->uri,
132: $env{'request.method'},$consumer_secret,
133: \%errors)) {
134: &invalid_request($r,$params,\%errors);
135: return OK;
136: }
137:
138: #
139: # Determine if nonce in POSTed data has expired.
140: # If unexpired, confirm it has not already been used.
141:
142: unless (&LONCAPA::ltiutils::check_nonce($params->{'oauth_nonce'},$params->{'oauth_timestamp'},
143: $ltitools{'lifetime'},$cdom,$r->dir_config('lonLTIDir'))) {
1.3 raeburn 144: $errors{16} = 1;
1.1 raeburn 145: &invalid_request($r,$params,\%errors);
146: return OK;
147: }
148:
149: #
150: # Verify that the sourcedid has not been tampered with,
151: # and the gradesecret used to create it is still valid.
152: #
153:
154: unless (&LONCAPA::ltiutils::verify_lis_item($resultsig,'grade',$digsymb,$diguser,$cdom,
155: $cnum,\%toolsettings,\%ltitools,\%errors)) {
156: &invalid_request($r,$params,\%errors);
157: return OK;
158: }
159:
160: #
161: # Does the user have an active role in the course which maps to one of
162: # the supported LTI roles
163: #
164:
165: if (($uname ne '') && ($udom ne '')) {
166: my %maproles;
167: if (ref($ltitools{'roles'}) eq 'HASH') {
168: %maproles = %{$ltitools{'roles'}};
169: }
170: unless (keys(%maproles)) {
1.3 raeburn 171: $errors{21} = 1;
1.1 raeburn 172: &invalid_request($r,$params,\%errors);
173: return OK;
174: }
175: my ($crstype,$hasrole);
176: my @allroles = &Apache::lonuserutils::roles_by_context('course',0,$crstype);
177: my (%availableroles,$coursepersonnel,$includestudents,%users);
178: foreach my $role (@allroles) {
179: if (exists($maproles{$role})) {
180: $availableroles{$role} = 1;
181: if ($role eq 'st') {
182: $includestudents = 1;
183: } else {
184: $coursepersonnel = 1;
185: }
186: }
187: }
188: if (keys(%availableroles)) {
189: my $courseurl = "/$cdom/$cnum";
190: my %roleshash = &Apache::lonnet::dump('roles',$udom,$uname,$courseurl);
191: if (keys(%roleshash)) {
192: my $now = time;
193: foreach my $key (keys(%roleshash)) {
194: if ($key =~ m{^\Q$courseurl\E(|/\w+)_(\w+)$}) {
195: my ($secgroup,$rolecode) = ($1,$2);
196: next if ($rolecode eq 'gr');
197: next unless ($availableroles{$rolecode});
198: my ($dummy,$end,$start)=split(/\_/,$roleshash{$key});
199: next if (defined($end) && $end && ($now > $end));
200: next if (defined($start) && $start && ($now < $start));
201: $hasrole = 1;
202: last;
203: }
204: }
205: }
206: }
207: unless ($hasrole) {
1.3 raeburn 208: $errors{22} = 1;
1.1 raeburn 209: &invalid_request($r,$params,\%errors);
210: return OK;
211: }
212: } else {
1.3 raeburn 213: $errors{23} = 1;
1.1 raeburn 214: &invalid_request($r,$params,\%errors);
215: return OK;
216: }
217:
218: #
219: # Store result if one was sent in a valid format.
220: #
221:
222:
223: my ($result,$resulttype,$lang,$pcf);
224: if (exists($params->{'result_resultvaluesourcedid'})) {
225: $resulttype = $params->{'result_resultvaluesourcedid'};
226: $resulttype =~ s/(^\s+|\s+)$//g;
1.2 raeburn 227: } else {
228: $resulttype = 'decimal';
1.5 ! raeburn 229: }
1.1 raeburn 230: $result = $params->{'result_resultscore_textstring'};
231: $result =~ s/(^\s+|\s+)$//g;
232: my $posslang = $params->{'result_resultscore_language'};
233: $posslang =~ s/(^\s+|\s+)$//g;
234: if ($posslang =~ /^\w+(|\-\w+(|\-w+))$/) {
235: $lang = $posslang;
236: }
237: if (($resulttype eq 'ratio') || ($resulttype eq 'decimal') || ($resulttype eq 'percentage')) {
238: if ($resulttype eq 'ratio') {
239: my ($numerator,$denominator) = split(/\s*\/\s*/,$result,2);
240: $numerator =~ s/(^\s+|\s+)$//g;
241: $denominator =~ s/(^\s+|\s+)$//g;
242: if (($numerator =~ /^\d+$/) && ($denominator =~ /^\d+$/) && ($denominator !=0)) {
243: eval {
244: $pcf = $numerator/$denominator;
245: };
246: }
247: if ($@) {
1.3 raeburn 248: $errors{24} = 1;
1.1 raeburn 249: &invalid_request($r,$params,\%errors);
250: return OK;
251: }
252: } elsif ($resulttype eq 'decimal') {
253: if (($result ne '') && ($result =~ /^\d*\.?\d*$/)) {
254: if ($result eq '.') {
255: $result = 0;
256: }
257: if (($result >= 0) && ($result <= 1)) {
258: $pcf = $result;
259: }
260: }
261: } elsif ($resulttype eq 'percentage') {
262: if ($result =~ /^(\d+)\s*\%?$/) {
263: my $percent = $1;
264: if (($percent >= 0) && ($percent <= 100)) {
265: $pcf = $percent/100.0;
266: }
267: }
268: }
269: if ($pcf ne '') {
270: my %newrecord=();
271: my $reckey = 'resource.0.solved';
272: my %record = &Apache::lonnet::restore($symb,$cdom.'_'.$cnum,$udom,$uname);
1.5 ! raeburn 273: my $tries = 0;
! 274: if ($record{'resource.0.tries'} =~ /^\d$/) {
! 275: $tries = $record{'resource.0.tries'};
! 276: }
1.1 raeburn 277: if ($record{'resource.0.awarded'} ne $pcf) {
278: $newrecord{'resource.0.awarded'} = $pcf;
279: }
280: if ($pcf == 0) {
1.5 ! raeburn 281: if ($record{$reckey} ne 'incorrect_by_passback') {
! 282: $newrecord{$reckey} = 'incorrect_by_passback';
1.1 raeburn 283: }
284: } else {
1.5 ! raeburn 285: if ($record{$reckey} ne 'correct_by_passback') {
! 286: $newrecord{$reckey} = 'correct_by_passback';
1.1 raeburn 287: }
288: }
289: if (%newrecord) {
1.5 ! raeburn 290: $newrecord{'resource.0.tries'} = 1 + $tries;
1.4 raeburn 291: $env{'request.course.id'} = $cdom.'_'.$cnum;
1.1 raeburn 292: my $result = &Apache::lonnet::cstore(\%newrecord,$symb,$cdom.'_'.$cnum,
293: $udom,$uname);
1.4 raeburn 294: delete($env{'request.course.id'});
1.1 raeburn 295: if (($result eq 'ok') || ($result eq 'con_delayed')) {
296: &success($r,$params->{'sourcedid'},$resulttype,$result,$lang);
297: } else {
1.3 raeburn 298: $errors{25} = 1;
1.1 raeburn 299: &invalid_request($r,$params,\%errors);
300: }
1.5 ! raeburn 301: } else {
! 302: &success($r,$params->{'sourcedid'},$resulttype,$result,$lang);
1.1 raeburn 303: }
304: } else {
1.3 raeburn 305: $errors{26} = 1;
1.1 raeburn 306: &invalid_request($r,$params,\%errors);
307: }
308: } else {
1.3 raeburn 309: $errors{27} = 1;
1.1 raeburn 310: &invalid_request($r,$params,\%errors);
311: }
312: return OK;
313: }
314:
315: sub success {
316: my ($r,$sourcedid,$scoretype,$score,$lang) = @_;
317: my $date = &Apache::loncommon::utc_string(time);
318: &Apache::loncommon::content_type($r,'text/xml');
319: $r->send_http_header;
320: if ($r->header_only) {
321: return;
322: }
323: $r->print(<<"END");
324: <?xml version="1.0" encoding="UTF-8" ?>
325: <message_response>
326: <lti_message_type>basic-lis-updateresult</lti_message_type>
327: <statusinfo>
328: <codemajor>Success</codemajor>
329: <severity>Status</severity>
330: <codeminor>fullsuccess</codeminor>
331: <description>Grade updated</description>
332: </statusinfo>
333: <result>
334: <sourcedid>$sourcedid</sourcedid>
335: <date>$date</date>
336: <resultscore>
337: <resultvaluesourcedid>$scoretype</resultvaluesourcedid>
338: <textstring>$score</textstring>
339: <language>$lang</language>
340: </resultscore>
341: </result>
342: </message_response>
343: END
344: return;
345: }
346:
347: sub invalid_request {
348: my ($r,$params,$errors) = @_;
349: my $date = &Apache::loncommon::utc_string(time);
350: my ($scoretype,$score,$lang);
351: if (ref($params) eq 'HASH') {
352: if ($params->{'result_resultvaluesourcedid'} =~ /^\s*(decimal|percentage|ratio)\s*$/) {
353: $scoretype = $1;
354: }
355: if ($scoretype eq 'decimal') {
356: if ($params->{'result_resultscore_textstring'} =~ /^\s*(\d*\.?\d*)\s*$/) {
357: $score = $1;
358: }
359: } elsif ($scoretype eq 'ratio') {
360: if ($params->{'result_resultscore_textstring'} =~ m{^\s*(\d+)\s*/\s*(\d+)\s*$}) {
361: $score = $1.'/'.$2;
362: }
363: } elsif ($scoretype eq 'percentage') {
364: if ($params->{'result_resultscore_textstring'} =~ /^\s*(\d+)\s*(\%?)\s*$/) {
365: $score = $1.$2;
366: }
367: }
368: my $posslang = $params->{'result_resultscore_language'};
369: $posslang =~ s/(^\s+|\s+)$//g;
370: if ($posslang =~ /^\w+(|\-\w+(|\-w+))$/) {
371: $lang = $posslang;
372: }
373: }
374: my $errormsg;
375: if (ref($errors) eq 'HASH') {
376: $errormsg = join(',',keys(%{$errors}));
377: }
378: &Apache::loncommon::content_type($r,'text/xml');
379: $r->send_http_header;
380: if ($r->header_only) {
381: return;
382: }
383: $r->print(<<"END");
384: <message_response>
385: <lti_message_type>basic-lis-updateresult</lti_message_type>
386: <statusinfo>
387: <codemajor>Failure</codemajor>
388: <severity>Error</severity>
389: <codeminor>$errormsg</codeminor>
390: </statusinfo>
391: <result>
392: <sourcedid>$params->{'sourcedid'}</sourcedid>
393: <statusofresult>interim</statusofresult>
394: <date>$date</date>
395: <resultscore>
396: <resultvaluesourcedid>$scoretype</resultvaluesourcedid>
397: <textstring>$score</textstring>
398: <language>$lang</language>
399: </resultscore>
400: </result>
401: </message_response>
402: END
403: return;
404: }
405:
406: 1;
407:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to ltipassback.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / lti