Annotation of loncom/cgi/enrollqueued.pl, revision 1.3
1.1 raeburn 1: #!/usr/bin/perl
2: $|=1;
3: # Script to complete processing of self-enrollment requests
4: # queued pending validation, when validated.
5: #
1.3 ! raeburn 6: # $Id: enrollqueued.pl,v 1.2 2014/04/05 22:42:33 raeburn Exp $
1.1 raeburn 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;
1.2 raeburn 82: use IO::Socket;
1.1 raeburn 83:
84: &main();
85: exit 0;
86:
87: #############################################
88: #############################################
89:
90: =pod
91:
92: =item main()
93:
94: Inputs: None
95:
96: Returns: Nothing
97:
98: Description: Main program. Determines if requesting IP is the IP
1.3 ! raeburn 99: of the of the validation server (as specified in
! 100: the domain configuration for self-enrollment).
! 101: Side effects are to print content (with text/plain
! 102: HTTP header). Content is the URL self-enrolling user
! 103: should use to access the course.
1.1 raeburn 104:
105: =cut
106:
107: #############################################
108: #############################################
109:
110: sub main {
111: my $query = CGI->new();
112:
113: my @okdoms = &Apache::lonnet::current_machine_domains();
114:
115: my $perlvar = &LONCAPA::Configuration::read_conf();
116: my $lonidsdir;
117: if (ref($perlvar) eq 'HASH') {
118: $lonidsdir = $perlvar->{'lonIDsDir'};
119: }
120: undef($perlvar);
121:
122: my $dom;
123: if ($query->param('course')) {
124: my $course = $query->param('course');
125: $course =~ s/^\s+|\s+$//g;
126: if ($course =~ /^($LONCAPA::match_domain)_($LONCAPA::match_courseid)$/) {
127: my $possdom = $1;
128: my $domdesc = &Apache::lonnet::domain($possdom);
129: unless ($domdesc eq '') {
130: $dom = $possdom;
131: }
132: }
133: }
134:
135: if ($dom eq '') {
136: if ($query->param('domain')) {
137: my $possdom = $query->param('domain');
138: $possdom =~ s/^\s+|\s+$//g;
139: if ($possdom =~ /^$LONCAPA::match_domain$/) {
140: my $domdesc = &Apache::lonnet::domain($possdom);
141: unless ($domdesc eq '') {
142: $dom = $possdom;
143: }
144: }
145: }
146: }
147:
148: if ($dom eq '') {
149: $dom = &Apache::lonnet::default_login_domain();
150: }
151:
152: if ($dom eq '') {
153: print &LONCAPA::loncgi::cgi_header('text/plain',1);
154: return;
155: }
156:
157: if (!grep(/^\Q$dom\E$/,@okdoms)) {
158: print &LONCAPA::loncgi::cgi_header('text/plain',1);
159: return;
160: }
161:
162: my %domconfig = &Apache::lonnet::get_dom('configuration',['selfenrollment'],$dom);
163: my $remote_ip = $ENV{'REMOTE_ADDR'};
164: my $allowed;
165:
166: if (ref($domconfig{'selfenrollment'}) eq 'HASH') {
167: if (ref($domconfig{'selfenrollment'}{'validation'}) eq 'HASH') {
168: if ($domconfig{'selfenrollment'}{'validation'}{'url'} =~ m{^https?://([^/]+)/}) {
1.2 raeburn 169: my $ip = gethostbyname($1);
170: if ($ip ne '') {
171: my $validator_ip = inet_ntoa($ip);
172: if (($validator_ip ne '') && ($remote_ip eq $validator_ip)) {
173: $allowed = 1;
174: }
175: }
176: } elsif ($domconfig{'selfenrollment'}{'validation'}{'url'} =~ m{^/}) {
177: if ($remote_ip ne '') {
178: if (($remote_ip eq '127.0.0.1') || ($remote_ip eq $ENV{'SERVER_ADDR'})) {
179: $allowed = 1;
180: }
1.1 raeburn 181: }
182: }
183: }
184: }
1.2 raeburn 185:
1.1 raeburn 186: my (%params,@fields,$numrequired);
1.2 raeburn 187: if ($allowed) {
1.1 raeburn 188: &Apache::lonlocal::get_language_handle();
189: my ($validreq,@fields);
190: if (ref($domconfig{'selfenrollment'}) eq 'HASH') {
191: if (ref($domconfig{'selfenrollment'}{'validation'}) eq 'HASH') {
192: if (ref($domconfig{'selfenrollment'}{'validation'}{'fields'}) eq 'ARRAY') {
1.2 raeburn 193: $numrequired = scalar(@{$domconfig{'selfenrollment'}{'validation'}{'fields'}});
1.1 raeburn 194: foreach my $field (@{$domconfig{'selfenrollment'}{'validation'}{'fields'}}) {
195: $params{$field} = $query->param($field);
196: if ($field eq 'username') {
197: if ($query->param($field) =~ /^LONCAPA::match_username$/) {
198: $params{$field} = $query->param($field);
199: }
200: }
201: if ($field eq 'domain') {
1.3 ! raeburn 202: if ($query->param($field) =~ /^LONCAPA::match_domain$/) {
1.1 raeburn 203: $params{$field} = $query->param($field);
204: }
205: }
206: if ($field eq 'course') {
207: if ($query->param($field) =~ /^(?:LONCAPA::match_domain)_(?:LONCAPA::match_courseid)$/) {
208: $params{$field} = $query->param($field);
209: }
210: }
211: if ($field eq 'coursetype') {
212: if ($query->param($field) =~ /^(official|unofficial|community|textbook)$/) {
213: $params{$field} = $query->param($field);
214: }
215: }
216: if ($field eq 'uniquecode') {
217: if ($query->param($field) =~ /^\w{6}$/) {
218: $params{$field} = $query->param($field);
219: }
220: }
1.2 raeburn 221: if ($field eq 'description') {
222: $params{$field} = $query->param($field);
223: }
1.1 raeburn 224: }
225: if ($numrequired == scalar(keys(%params))) {
226: $validreq = 1;
227: }
228: }
229: }
230: }
231: print &LONCAPA::loncgi::cgi_header('text/plain',1);
232: if ($validreq) {
233: print(&process_enrollment($dom,$lonidsdir,\%params,\@fields));
234: }
235: } else {
236: print &LONCAPA::loncgi::cgi_header('text/plain',1);
237: }
238: return;
239: }
240:
241: #############################################
242: #############################################
243:
244: =pod
245:
246: =item process_enrollment()
247:
248: Inputs: $dom - domain of course for which enrollment is to be processed
249: $lonidsdir - Path to directory containing session files for users.
250: Perl var lonIDsDir is read from loncapa_apache.conf
251: in &main() and passed as third arg to process_enrollment().
252: $params - references to hash of key=value pairs from input
253: (either query string or POSTed). Keys which will be
254: used are fields specified in domain configuration
255: for self-enrollment validation.
256:
257: Returns: $output - output to display.
258: If processing of the pending self-enrollment succeeds,
259: a URL is returned which may be used by the user to access
260: the course.
261:
262: Description: Processes a pending self-enrollment request, given the username
263: domain, and courseID or six character code for the course.
264:
265: =cut
266:
267: #############################################
268: #############################################
269:
270: sub process_enrollment {
271: my ($dom,$lonidsdir,$params) = @_;
272: return unless (ref($params) eq 'HASH');
273:
274: my $cid = $params->{'course'};
275: my $uname = $params->{'username'};
276: my $udom = $params->{'domain'};
277: my $token = $params->{'token'};
278: my $uhome = &Apache::lonnet::homeserver($uname,$udom);
1.3 ! raeburn 279: return if ($uhome eq 'no_host');
1.1 raeburn 280: my %courseinfo;
281: if ($cid eq '') {
282: if ($params->{'uniquecode'}) {
283: my $uniquecode = $params->{'uniquecode'};
284: my $confname = $dom.'-domainconfig';
285: my %codes = &Apache::lonnet::get('uniquecodes',[$uniquecode],$dom,$confname);
286: if ($codes{$uniquecode}) {
287: $cid = $dom.'_'.$codes{$uniquecode};
288: }
289: }
290: }
291: return if ($cid eq '');
292: my $url;
293: if ($cid) {
294: %courseinfo = &Apache::lonnet::coursedescription($cid,{one_time => 1});
295: if ($courseinfo{'description'} ne '') {
296: my $cdom = $courseinfo{'domain'};
297: my $cnum = $courseinfo{'num'};
298: my %requesthash = &Apache::lonnet::get('selfenrollrequests',[$cid],$udom,$uname);
299: if (ref($requesthash{$cid}) eq 'HASH') {
300: if ($requesthash{$cid}{status} eq 'pending') {
301: my ($lonhost,$hostname,$handle);
302: $lonhost = $requesthash{$cid}{'lonhost'};
1.2 raeburn 303: if ($lonhost ne '') {
1.1 raeburn 304: $hostname = &Apache::lonnet::hostname($lonhost);
305: }
306: my $savedtoken = $requesthash{$cid}{'token'};
307: my $enroll = 1;
308: if ($token ne '') {
309: if ($token ne $savedtoken) {
310: $enroll = 0;
311: }
312: }
313: if ($enroll) {
314: my $handle = $requesthash{$cid}{'handle'};
315: my $usec = $courseinfo{'internal.selfenroll_section'};
316: my $access_start = $courseinfo{'internal.selfenroll_start_access'};
317: my $access_end = $courseinfo{'internal.selfenroll_end_access'};
318: my $limit = $courseinfo{'internal.selfenroll_limit'};
319: my $cap = $courseinfo{'internal.selfenroll_cap'};
320: my $notifylist = $courseinfo{'internal.selfenroll_notifylist'};
321: my ($stucounts,$idx,$classlist) = &get_student_counts($cdom,$cnum);
322: if (($limit eq 'allstudents') || ($limit eq 'selfenrolled')) {
323: if ($stucounts->{$limit} >= $cap) {
324: return;
325: }
326: }
1.2 raeburn 327: $Apache::lonnet::env{'user.name'} = $uname;
328: $Apache::lonnet::env{'user.domain'} = $udom;
1.1 raeburn 329: my $result =
330: &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
331: undef,undef,undef,$usec,$access_end,$access_start,'selfenroll',
332: undef,$cid,1);
1.2 raeburn 333: delete($Apache::lonnet::env{'user.name'});
334: delete($Apache::lonnet::env{'user.domain'});
1.1 raeburn 335: if ($result eq 'ok') {
336: my %userrequest = (
337: $cdom.'_'.$cnum => {
338: timestamp => time,
339: section => $usec,
340: adjudicator => 'enrollqueued',
341: status => 'approved',
342: },
343: );
344: my $userresult =
345: &Apache::lonnet::put('selfenrollrequests',\%userrequest,$udom,$uname);
346: #
347: # check for session for this user
348: # if session, construct URL point at check for new roles.
349: #
350: my @hosts = &Apache::lonnet::current_machine_ids();
351: if (grep(/^\Q$lonhost\E$/,@hosts) && ($handle) && ($hostname)) {
1.2 raeburn 352: if ($lonidsdir ne '') {
1.1 raeburn 353: if (-e "$lonidsdir/$handle.id") {
354: my $protocol = $Apache::lonnet::protocol{$lonhost};
355: $protocol = 'http' if ($protocol ne 'https');
356: $url = $protocol.'://'.$hostname.'/adm/roles?state=doupdate';
357: }
358: }
359: }
1.2 raeburn 360:
1.1 raeburn 361: #
362: # otherwise point at default portal, or if non specified, at /adm/login?querystring where
363: # querystring contains role=st./$cdom/$cnum
364: #
365: if ($url eq '') {
366: my %domdefaults = &Apache::lonnet::get_domain_defaults($cdom);
367: if ($domdefaults{'portal_def'}) {
368: $url = $domdefaults{'portal_def'};
369: } else {
370: my $chome = &Apache::lonnet::homeserver($cnum,$cdom);
371: my $hostname = &Apache::lonnet::hostname($chome);
372: my $protocol = $Apache::lonnet::protocol{$chome};
373: $protocol = 'http' if ($protocol ne 'https');
374: $url = $protocol.'://'.$hostname.'/adm/login?role=st./'.$cdom.'/'.$cnum;
375: }
376: }
377: }
378: }
379: }
380: }
381: }
382: }
383: return $url;
384: }
385:
386: sub get_student_counts {
387: my ($cdom,$cnum) = @_;
388: my (%idx,%stucounts);
389: my $classlist = &Apache::loncoursedata::get_classlist($cdom,$cnum);
390: $idx{'type'} = &Apache::loncoursedata::CL_TYPE();
391: $idx{'status'} = &Apache::loncoursedata::CL_STATUS();
392: while (my ($student,$data) = each(%$classlist)) {
393: if (($data->[$idx{'status'}] eq 'Active') ||
394: ($data->[$idx{'status'}] eq 'Future')) {
395: if ($data->[$idx{'type'}] eq 'selfenroll') {
396: $stucounts{'selfenroll'} ++;
397: }
398: $stucounts{'allstudents'} ++;
399: }
400: }
401: return (\%stucounts,\%idx,$classlist);
402: }
403:
404:
405: =pod
406:
407: =back
408:
409: =cut
410:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to enrollqueued.pl CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / cgi