Annotation of loncom/lti/ltiutils.pm, revision 1.9.2.1
1.1 raeburn 1: # The LearningOnline Network with CAPA
2: # Utility functions for managing LON-CAPA LTI interactions
3: #
1.9.2.1 ! raeburn 4: # $Id: ltiutils.pm,v 1.9 2018/05/15 04:33:17 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 LONCAPA::ltiutils;
30:
31: use strict;
32: use Net::OAuth;
33: use Digest::SHA;
34: use Apache::lonnet;
35: use Apache::loncommon;
36: use LONCAPA qw(:DEFAULT :match);
37:
38: #
1.9.2.1 ! raeburn 39: # LON-CAPA as LTI Consumer
1.1 raeburn 40: #
41: # Determine if a nonce in POSTed data has expired.
42: # If unexpired, confirm it has not already been used.
43: #
44: # When LON-CAPA is operating as a Consumer, nonce checking
45: # occurs when a Tool Provider launched from an instance of
46: # an external tool in a LON-CAPA course makes a request to
47: # (a) /adm/service/roster or (b) /adm/service/passback to,
48: # respectively, retrieve a roster or store the grade for
49: # the original launch by a specific user.
50: #
51:
52: sub check_nonce {
53: my ($nonce,$timestamp,$lifetime,$domain,$ltidir) = @_;
54: if (($ltidir eq '') || ($timestamp eq '') || ($timestamp =~ /^\D/) ||
55: ($lifetime eq '') || ($lifetime =~ /\D/) || ($domain eq '')) {
56: return;
57: }
58: my $now = time;
59: if (($timestamp) && ($timestamp < ($now - $lifetime))) {
60: return;
61: }
62: if ($nonce eq '') {
63: return;
64: }
65: if (-e "$ltidir/$domain/$nonce") {
66: return;
67: } else {
68: unless (-e "$ltidir/$domain") {
69: unless (mkdir("$ltidir/$domain",0755)) {
70: return;
71: }
72: }
73: if (open(my $fh,'>',"$ltidir/$domain/$nonce")) {
74: print $fh $now;
75: close($fh);
76: return 1;
77: }
78: }
79: return;
80: }
81:
82: #
83: # LON-CAPA as LTI Consumer
84: #
85: # Determine the domain and the courseID of the LON-CAPA course
86: # for which access is needed by a Tool Provider -- either to
87: # retrieve a roster or store the grade for an instance of an
88: # external tool in the course.
89: #
90:
91: sub get_loncapa_course {
92: my ($lonhost,$cid,$errors) = @_;
93: return unless (ref($errors) eq 'HASH');
94: my ($cdom,$cnum);
95: if ($cid =~ /^($match_domain)_($match_courseid)$/) {
96: my ($posscdom,$posscnum) = ($1,$2);
97: my $cprimary_id = &Apache::lonnet::domain($posscdom,'primary');
98: if ($cprimary_id eq '') {
99: $errors->{5} = 1;
100: return;
101: } else {
102: my @intdoms;
103: my $internet_names = &Apache::lonnet::get_internet_names($lonhost);
104: if (ref($internet_names) eq 'ARRAY') {
105: @intdoms = @{$internet_names};
106: }
107: my $cintdom = &Apache::lonnet::internet_dom($cprimary_id);
108: if (($cintdom ne '') && (grep(/^\Q$cintdom\E$/,@intdoms))) {
109: $cdom = $posscdom;
110: } else {
111: $errors->{6} = 1;
112: return;
113: }
114: }
115: my $chome = &Apache::lonnet::homeserver($posscnum,$posscdom);
116: if ($chome =~ /(con_lost|no_host|no_such_host)/) {
117: $errors->{7} = 1;
118: return;
119: } else {
120: $cnum = $posscnum;
121: }
122: } else {
123: $errors->{8} = 1;
124: return;
125: }
126: return ($cdom,$cnum);
127: }
128:
129: #
130: # LON-CAPA as LTI Consumer
131: #
132: # Determine the symb and (optionally) LON-CAPA user for an
133: # instance of an external tool in a course -- either to
134: # to retrieve a roster or store a grade.
135: #
136: # Use the digested symb to lookup the real symb in exttools.db
137: # and the digested userID to lookup the real userID (if needed).
138: # and extract the exttool instance and symb.
139: #
140:
141: sub get_tool_instance {
142: my ($cdom,$cnum,$digsymb,$diguser,$errors) = @_;
143: return unless (ref($errors) eq 'HASH');
144: my ($marker,$symb,$uname,$udom);
145: my @keys = ($digsymb);
146: if ($diguser) {
147: push(@keys,$diguser);
148: }
149: my %digesthash = &Apache::lonnet::get('exttools',\@keys,$cdom,$cnum);
150: if ($digsymb) {
151: $symb = $digesthash{$digsymb};
152: if ($symb) {
153: my ($map,$id,$url) = split(/___/,$symb);
154: $marker = (split(m{/},$url))[3];
155: $marker=~s/\D//g;
156: } else {
157: $errors->{9} = 1;
158: }
159: }
160: if ($diguser) {
161: if ($digesthash{$diguser} =~ /^($match_username):($match_domain)$/) {
162: ($uname,$udom) = ($1,$2);
163: } else {
164: $errors->{10} = 1;
165: }
166: return ($marker,$symb,$uname,$udom);
167: } else {
168: return ($marker,$symb);
169: }
170: }
171:
172: #
173: # LON-CAPA as LTI Consumer
174: #
175: # Verify a signed request using the consumer_key and
176: # secret for the specific LTI Provider.
177: #
178:
179: sub verify_request {
180: my ($params,$protocol,$hostname,$requri,$reqmethod,$consumer_secret,$errors) = @_;
181: return unless (ref($errors) eq 'HASH');
182: my $request = Net::OAuth->request('request token')->from_hash($params,
183: request_url => $protocol.'://'.$hostname.$requri,
184: request_method => $reqmethod,
185: consumer_secret => $consumer_secret,);
186: unless ($request->verify()) {
187: $errors->{15} = 1;
188: return;
189: }
190: }
191:
192: #
193: # LON-CAPA as LTI Consumer
194: #
195: # Sign a request used to launch an instance of an external
1.4 raeburn 196: # tool in a LON-CAPA course, using the key and secret supplied
1.1 raeburn 197: # by the Tool Provider.
198: #
199:
200: sub sign_params {
1.3 raeburn 201: my ($url,$key,$secret,$sigmethod,$paramsref) = @_;
1.1 raeburn 202: return unless (ref($paramsref) eq 'HASH');
1.3 raeburn 203: if ($sigmethod eq '') {
204: $sigmethod = 'HMAC-SHA1';
205: }
1.9 raeburn 206: srand( time() ^ ($$ + ($$ << 15)) ); # Seed rand.
1.1 raeburn 207: my $nonce = Digest::SHA::sha1_hex(sprintf("%06x%06x",rand(0xfffff0),rand(0xfffff0)));
208: my $request = Net::OAuth->request("request token")->new(
209: consumer_key => $key,
210: consumer_secret => $secret,
211: request_url => $url,
212: request_method => 'POST',
1.3 raeburn 213: signature_method => $sigmethod,
1.1 raeburn 214: timestamp => time,
215: nonce => $nonce,
216: callback => 'about:blank',
217: extra_params => $paramsref,
218: version => '1.0',
219: );
220: $request->sign;
221: return $request->to_hash();
222: }
223:
224: 1;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to ltiutils.pm CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / lti