File:
[LON-CAPA] /
loncom /
cgi /
enrollqueued.pl
Revision
1.1:
download - view:
text,
annotated -
select for diffs
Tue Apr 1 21:39:18 2014 UTC (10 years, 4 months ago) by
raeburn
Branches:
MAIN
CVS tags:
HEAD
- CGI script to process a self-enrollment request which had been queued,
pending validation.
- Script requires values for fields specified in domain configuration
for self-enrollment validation.
- Intended to support validation of self-enrollment requests on a
third party system/server which handles payment etc.
1: #!/usr/bin/perl
2: $|=1;
3: # Script to complete processing of self-enrollment requests
4: # queued pending validation, when validated.
5: #
6: # $Id: enrollqueued.pl,v 1.1 2014/04/01 21:39:18 raeburn Exp $
7: #
8: # Copyright Michigan State University Board of Trustees
9: #
10: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
11: #
12: # LON-CAPA is free software; you can redistribute it and/or modify
13: # it under the terms of the GNU General Public License as published by
14: # the Free Software Foundation; either version 2 of the License, or
15: # (at your option) any later version.
16: #
17: # LON-CAPA is distributed in the hope that it will be useful,
18: # but WITHOUT ANY WARRANTY; without even the implied warranty of
19: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20: # GNU General Public License for more details.
21: #
22: # You should have received a copy of the GNU General Public License
23: # along with LON-CAPA; if not, write to the Free Software
24: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
25: #
26: # /home/httpd/html/adm/gpl.txt
27: #
28: # http://www.lon-capa.org/
29: #
30: #############################################
31: #############################################
32:
33: =pod
34:
35: =head1 NAME
36:
37: enrollqueued.pl
38:
39: =head1 SYNOPSIS
40:
41: CGI script to process queued self-enrollment request
42: and output URL which user will return to if enrollment
43: successful.
44:
45: Data expected by enrollqueued.pl are the same fields
46: as included for a POST to the external validation site,
47: as specified in the domain configuration for
48: self-enrollment validation, which can be some or all of:
49:
50: 1. Unique six-character code
51: 2. courseID (domain_coursenum)
52: 3. student's username
53: 4. student's domain
54: 5. token
55:
56: Either 1 or 2 are required, and 3 is required. If 4 is
57: not provided, the student's domain will be assumed to
58: be the same as the course (from 2).
59:
60: The data can be passed either in a query string or as
61: POSTed form variables.
62:
63: =head1 Subroutines
64:
65: =over 4
66:
67: =cut
68:
69: #############################################
70: #############################################
71:
72: use strict;
73:
74: use lib '/home/httpd/lib/perl/';
75: use LONCAPA::loncgi;
76: use Apache::lonnet();
77: use Apache::loncommon();
78: use Apache::lonuserutils();
79: use Apache::loncoursequeueadmin();
80: use Apache::lonlocal;
81: use LONCAPA;
82:
83: &main();
84: exit 0;
85:
86: #############################################
87: #############################################
88:
89: =pod
90:
91: =item main()
92:
93: Inputs: None
94:
95: Returns: Nothing
96:
97: Description: Main program. Determines if requesting IP is the IP
98: of the server enrollqueued.pl. Side effects
99: prints content (with text/plain HTTP header).
100: Content is URL self-enrolling user should user
101: to access the course.
102:
103: =cut
104:
105: #############################################
106: #############################################
107:
108: sub main {
109: my $query = CGI->new();
110:
111: my @okdoms = &Apache::lonnet::current_machine_domains();
112:
113: my $perlvar = &LONCAPA::Configuration::read_conf();
114: my $lonidsdir;
115: if (ref($perlvar) eq 'HASH') {
116: $lonidsdir = $perlvar->{'lonIDsDir'};
117: }
118: undef($perlvar);
119:
120: my $dom;
121: if ($query->param('course')) {
122: my $course = $query->param('course');
123: $course =~ s/^\s+|\s+$//g;
124: if ($course =~ /^($LONCAPA::match_domain)_($LONCAPA::match_courseid)$/) {
125: my $possdom = $1;
126: my $domdesc = &Apache::lonnet::domain($possdom);
127: unless ($domdesc eq '') {
128: $dom = $possdom;
129: }
130: }
131: }
132:
133: if ($dom eq '') {
134: if ($query->param('domain')) {
135: my $possdom = $query->param('domain');
136: $possdom =~ s/^\s+|\s+$//g;
137: if ($possdom =~ /^$LONCAPA::match_domain$/) {
138: my $domdesc = &Apache::lonnet::domain($possdom);
139: unless ($domdesc eq '') {
140: $dom = $possdom;
141: }
142: }
143: }
144: }
145:
146: if ($dom eq '') {
147: $dom = &Apache::lonnet::default_login_domain();
148: }
149:
150: if ($dom eq '') {
151: print &LONCAPA::loncgi::cgi_header('text/plain',1);
152: return;
153: }
154:
155: if (!grep(/^\Q$dom\E$/,@okdoms)) {
156: print &LONCAPA::loncgi::cgi_header('text/plain',1);
157: return;
158: }
159:
160: my %domconfig = &Apache::lonnet::get_dom('configuration',['selfenrollment'],$dom);
161: my $remote_ip = $ENV{'REMOTE_ADDR'};
162: my $allowed;
163:
164: if (ref($domconfig{'selfenrollment'}) eq 'HASH') {
165: if (ref($domconfig{'selfenrollment'}{'validation'}) eq 'HASH') {
166: if ($domconfig{'selfenrollment'}{'validation'}{'url'} =~ m{^https?://([^/]+)/}) {
167: my $validator_ip = gethostbyname($1);
168: if (($validator_ip ne '') && ($remote_ip eq $validator_ip)) {
169: $allowed = 1;
170: }
171: }
172: }
173: }
174: my (%params,@fields,$numrequired);
175: if ($allowed ne '') {
176: &Apache::lonlocal::get_language_handle();
177: my ($validreq,@fields);
178: if (ref($domconfig{'selfenrollment'}) eq 'HASH') {
179: if (ref($domconfig{'selfenrollment'}{'validation'}) eq 'HASH') {
180: if (ref($domconfig{'selfenrollment'}{'validation'}{'fields'}) eq 'ARRAY') {
181: $numrequired = @fields;
182: foreach my $field (@{$domconfig{'selfenrollment'}{'validation'}{'fields'}}) {
183: $params{$field} = $query->param($field);
184: if ($field eq 'username') {
185: if ($query->param($field) =~ /^LONCAPA::match_username$/) {
186: $params{$field} = $query->param($field);
187: }
188: }
189: if ($field eq 'domain') {
190: if ($query->param($field) =~ /^LONCAPA::match_username$/) {
191: $params{$field} = $query->param($field);
192: }
193: }
194: if ($field eq 'course') {
195: if ($query->param($field) =~ /^(?:LONCAPA::match_domain)_(?:LONCAPA::match_courseid)$/) {
196: $params{$field} = $query->param($field);
197: }
198: }
199: if ($field eq 'coursetype') {
200: if ($query->param($field) =~ /^(official|unofficial|community|textbook)$/) {
201: $params{$field} = $query->param($field);
202: }
203: }
204: if ($field eq 'uniquecode') {
205: if ($query->param($field) =~ /^\w{6}$/) {
206: $params{$field} = $query->param($field);
207: }
208: }
209: }
210: if ($numrequired == scalar(keys(%params))) {
211: $validreq = 1;
212: }
213: }
214: }
215: }
216: print &LONCAPA::loncgi::cgi_header('text/plain',1);
217: if ($validreq) {
218: print(&process_enrollment($dom,$lonidsdir,\%params,\@fields));
219: }
220: } else {
221: print &LONCAPA::loncgi::cgi_header('text/plain',1);
222: }
223: return;
224: }
225:
226: #############################################
227: #############################################
228:
229: =pod
230:
231: =item process_enrollment()
232:
233: Inputs: $dom - domain of course for which enrollment is to be processed
234: $lonidsdir - Path to directory containing session files for users.
235: Perl var lonIDsDir is read from loncapa_apache.conf
236: in &main() and passed as third arg to process_enrollment().
237: $params - references to hash of key=value pairs from input
238: (either query string or POSTed). Keys which will be
239: used are fields specified in domain configuration
240: for self-enrollment validation.
241:
242: Returns: $output - output to display.
243: If processing of the pending self-enrollment succeeds,
244: a URL is returned which may be used by the user to access
245: the course.
246:
247: Description: Processes a pending self-enrollment request, given the username
248: domain, and courseID or six character code for the course.
249:
250: =cut
251:
252: #############################################
253: #############################################
254:
255: sub process_enrollment {
256: my ($dom,$lonidsdir,$params) = @_;
257: return unless (ref($params) eq 'HASH');
258:
259: my $cid = $params->{'course'};
260: my $uname = $params->{'username'};
261: my $udom = $params->{'domain'};
262: my $token = $params->{'token'};
263: my $uhome = &Apache::lonnet::homeserver($uname,$udom);
264: return if ($uhome eq 'nohost');
265: my %courseinfo;
266: if ($cid eq '') {
267: if ($params->{'uniquecode'}) {
268: my $uniquecode = $params->{'uniquecode'};
269: my $confname = $dom.'-domainconfig';
270: my %codes = &Apache::lonnet::get('uniquecodes',[$uniquecode],$dom,$confname);
271: if ($codes{$uniquecode}) {
272: $cid = $dom.'_'.$codes{$uniquecode};
273: }
274: }
275: }
276: return if ($cid eq '');
277: my $url;
278: if ($cid) {
279: %courseinfo = &Apache::lonnet::coursedescription($cid,{one_time => 1});
280: if ($courseinfo{'description'} ne '') {
281: my $cdom = $courseinfo{'domain'};
282: my $cnum = $courseinfo{'num'};
283: my %requesthash = &Apache::lonnet::get('selfenrollrequests',[$cid],$udom,$uname);
284: if (ref($requesthash{$cid}) eq 'HASH') {
285: if ($requesthash{$cid}{status} eq 'pending') {
286: my ($lonhost,$hostname,$handle);
287: $lonhost = $requesthash{$cid}{'lonhost'};
288: if ($lonhost eq '') {
289: $hostname = &Apache::lonnet::hostname($lonhost);
290: }
291: my $savedtoken = $requesthash{$cid}{'token'};
292: my $enroll = 1;
293: if ($token ne '') {
294: if ($token ne $savedtoken) {
295: $enroll = 0;
296: }
297: }
298: if ($enroll) {
299: my $handle = $requesthash{$cid}{'handle'};
300: my $usec = $courseinfo{'internal.selfenroll_section'};
301: my $access_start = $courseinfo{'internal.selfenroll_start_access'};
302: my $access_end = $courseinfo{'internal.selfenroll_end_access'};
303: my $limit = $courseinfo{'internal.selfenroll_limit'};
304: my $cap = $courseinfo{'internal.selfenroll_cap'};
305: my $notifylist = $courseinfo{'internal.selfenroll_notifylist'};
306: my ($stucounts,$idx,$classlist) = &get_student_counts($cdom,$cnum);
307: if (($limit eq 'allstudents') || ($limit eq 'selfenrolled')) {
308: if ($stucounts->{$limit} >= $cap) {
309: return;
310: }
311: }
312: my $result =
313: &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
314: undef,undef,undef,$usec,$access_end,$access_start,'selfenroll',
315: undef,$cid,1);
316: if ($result eq 'ok') {
317: my %userrequest = (
318: $cdom.'_'.$cnum => {
319: timestamp => time,
320: section => $usec,
321: adjudicator => 'enrollqueued',
322: status => 'approved',
323: },
324: );
325: my $userresult =
326: &Apache::lonnet::put('selfenrollrequests',\%userrequest,$udom,$uname);
327: #
328: # check for session for this user
329: # if session, construct URL point at check for new roles.
330: #
331: my @hosts = &Apache::lonnet::current_machine_ids();
332: if (grep(/^\Q$lonhost\E$/,@hosts) && ($handle) && ($hostname)) {
333: if ($lonidsdir ne '') {
334: if (-e "$lonidsdir/$handle.id") {
335: my $protocol = $Apache::lonnet::protocol{$lonhost};
336: $protocol = 'http' if ($protocol ne 'https');
337: $url = $protocol.'://'.$hostname.'/adm/roles?state=doupdate';
338: }
339: }
340: }
341: #
342: # otherwise point at default portal, or if non specified, at /adm/login?querystring where
343: # querystring contains role=st./$cdom/$cnum
344: #
345: if ($url eq '') {
346: my %domdefaults = &Apache::lonnet::get_domain_defaults($cdom);
347: if ($domdefaults{'portal_def'}) {
348: $url = $domdefaults{'portal_def'};
349: } else {
350: my $chome = &Apache::lonnet::homeserver($cnum,$cdom);
351: my $hostname = &Apache::lonnet::hostname($chome);
352: my $protocol = $Apache::lonnet::protocol{$chome};
353: $protocol = 'http' if ($protocol ne 'https');
354: $url = $protocol.'://'.$hostname.'/adm/login?role=st./'.$cdom.'/'.$cnum;
355: }
356: }
357: }
358: }
359: }
360: }
361: }
362: }
363: return $url;
364: }
365:
366: sub get_student_counts {
367: my ($cdom,$cnum) = @_;
368: my (%idx,%stucounts);
369: my $classlist = &Apache::loncoursedata::get_classlist($cdom,$cnum);
370: $idx{'type'} = &Apache::loncoursedata::CL_TYPE();
371: $idx{'status'} = &Apache::loncoursedata::CL_STATUS();
372: while (my ($student,$data) = each(%$classlist)) {
373: if (($data->[$idx{'status'}] eq 'Active') ||
374: ($data->[$idx{'status'}] eq 'Future')) {
375: if ($data->[$idx{'type'}] eq 'selfenroll') {
376: $stucounts{'selfenroll'} ++;
377: }
378: $stucounts{'allstudents'} ++;
379: }
380: }
381: return (\%stucounts,\%idx,$classlist);
382: }
383:
384:
385: =pod
386:
387: =back
388:
389: =cut
390:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>