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