1: #!/usr/bin/perl
2: $|=1;
3: # Script to complete processing of course/community requests
4: # for unofficial courses, textbook courses, communities and
5: # placement tests queued pending validation, once validated.
6: #
7: # $Id: createpending.pl,v 1.2 2016/08/17 14:35:57 raeburn Exp $
8: #
9: # Copyright Michigan State University Board of Trustees
10: #
11: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
12: #
13: # LON-CAPA is free software; you can redistribute it and/or modify
14: # it under the terms of the GNU General Public License as published by
15: # the Free Software Foundation; either version 2 of the License, or
16: # (at your option) any later version.
17: #
18: # LON-CAPA is distributed in the hope that it will be useful,
19: # but WITHOUT ANY WARRANTY; without even the implied warranty of
20: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21: # GNU General Public License for more details.
22: #
23: # You should have received a copy of the GNU General Public License
24: # along with LON-CAPA; if not, write to the Free Software
25: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
26: #
27: # /home/httpd/html/adm/gpl.txt
28: #
29: # http://www.lon-capa.org/
30: #
31: #############################################
32: #############################################
33:
34: =pod
35:
36: =head1 NAME
37:
38: createpending.pl
39:
40: =head1 SYNOPSIS
41:
42: CGI script to process pending course/community requests
43: and output URL which user will return to if course
44: creation successful.
45:
46: Data expected by createpending.pl are the same fields
47: as included for a POST to the external validation site,
48: as specified in the domain configuration for
49: course request validation, which can be some or all of:
50:
51: 1. courseID (domain_coursenum)
52: 2. requester's username:domain
53: 3. course type
54: 4. course description
55:
56: Both 1 and 2 are required, whereas 3 and 4 are optional.
57:
58: The data can be passed either in a query string or as
59: POSTed form variables.
60:
61: =head1 Subroutines
62:
63: =over 4
64:
65: =cut
66:
67: #############################################
68: #############################################
69:
70: use strict;
71:
72: use lib '/home/httpd/lib/perl/';
73: use LONCAPA::loncgi;
74: use Apache::lonnet;
75: use Apache::loncommon();
76: use Apache::lonuserutils();
77: use Apache::loncoursequeueadmin();
78: use Apache::lonlocal;
79: use LONCAPA;
80: use IO::Socket;
81:
82: &main();
83: exit 0;
84:
85: #############################################
86: #############################################
87:
88: =pod
89:
90: =item main()
91:
92: Inputs: None
93:
94: Returns: Nothing
95:
96: Description: Main program. Determines if requesting IP is the IP
97: of the validation server. Side effect is to
98: print content (with text/plain HTTP header).
99: Content is URL course requester should use
100: to access the course, when course creation
101: is successful.
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 ($cdom,$cnum);
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: $cdom = $possdom;
129: }
130: } else {
131: print &LONCAPA::loncgi::cgi_header('text/plain',1);
132: return;
133: }
134: }
135:
136: if ($cdom eq '') {
137: print &LONCAPA::loncgi::cgi_header('text/plain',1);
138: return;
139: }
140:
141: if (!grep(/^\Q$cdom\E$/,@okdoms)) {
142: print &LONCAPA::loncgi::cgi_header('text/plain',1);
143: return;
144: }
145:
146: my %domconfig = &Apache::lonnet::get_dom('configuration',['requestcourses'],$cdom);
147: my $remote_ip = $ENV{'REMOTE_ADDR'};
148: my $allowed;
149:
150: if (ref($domconfig{'requestcourses'}) eq 'HASH') {
151: if (ref($domconfig{'requestcourses'}{'validation'}) eq 'HASH') {
152: if ($domconfig{'requestcourses'}{'validation'}{'url'} =~ m{^https?://([^/]+)/}) {
153: my $ip = gethostbyname($1);
154: if ($ip ne '') {
155: my $validator_ip = inet_ntoa($ip);
156: if (($validator_ip ne '') && ($remote_ip eq $validator_ip)) {
157: $allowed = 1;
158: }
159: }
160: } elsif ($domconfig{'requestcourses'}{'validation'}{'url'} =~ m{^/}) {
161: if ($remote_ip ne '') {
162: if (($remote_ip eq '127.0.0.1') || ($remote_ip eq $ENV{'SERVER_ADDR'})) {
163: $allowed = 1;
164: }
165: }
166: }
167: }
168: }
169:
170: my (%params,@fields,$numrequired);
171: if ($allowed) {
172: &Apache::lonlocal::get_language_handle();
173: my ($validreq,@fields);
174: if (ref($domconfig{'requestcourses'}) eq 'HASH') {
175: if (ref($domconfig{'requestcourses'}{'validation'}) eq 'HASH') {
176: if (ref($domconfig{'requestcourses'}{'validation'}{'fields'}) eq 'ARRAY') {
177: $numrequired = scalar(@{$domconfig{'requestcourses'}{'validation'}{'fields'}});
178: foreach my $field (@{$domconfig{'requestcourses'}{'validation'}{'fields'}}) {
179: $params{$field} = $query->param($field);
180: if ($field eq 'owner') {
181: if ($query->param($field) =~ /^(LONCAPA::match_username):($LONCAPA::match_domain)$$/) {
182: $params{$field} = $query->param($field);
183: }
184: }
185: if ($field eq 'course') {
186: if ($query->param($field) =~ /^(?:LONCAPA::match_domain)_(?:LONCAPA::match_courseid)$/) {
187: $params{$field} = $query->param($field);
188: }
189: }
190: if ($field eq 'coursetype') {
191: if ($query->param($field) =~ /^(unofficial|community|textbook|placement)$/) {
192: $params{$field} = $query->param($field);
193: }
194: }
195: if ($field eq 'description') {
196: $params{$field} = $query->param($field);
197: }
198: }
199: if ($numrequired == scalar(keys(%params))) {
200: $validreq = 1;
201: }
202: }
203: }
204: }
205: print &LONCAPA::loncgi::cgi_header('text/plain',1);
206: if ($validreq) {
207: $params{'token'} = $query->param('token');
208: my ($url,$code) = &process_courserequest($cdom,$lonidsdir,\%params);
209: if ($url) {
210: print("$url\n$code");
211: }
212: }
213: } else {
214: print &LONCAPA::loncgi::cgi_header('text/plain',1);
215: }
216: return;
217: }
218:
219: #############################################
220: #############################################
221:
222: =pod
223:
224: =item process_courserequest()
225:
226: Inputs: $dom - domain of course to be created
227: $lonidsdir - Path to directory containing session files for users.
228: Perl var lonIDsDir is read from loncapa_apache.conf
229: in &main() and passed as third arg to process_courserequest().
230: $params - references to hash of key=value pairs from input
231: (either query string or POSTed). Keys which will be
232: used are fields specified in domain configuration
233: for validation of pending unofficial courses, textbook courses,
234: communities and placement tests.
235:
236: Returns: $url,$code - If processing of the pending course request succeeds,
237: a URL is returned which may be used by the requester to access
238: the new course. If a six character code was also set, that is
239: returned as a second item.
240:
241: Description: Processes a pending course creation request, given the username
242: and domain of the requester and the courseID of the new course.
243:
244: =cut
245:
246: #############################################
247: #############################################
248:
249: sub process_courserequest {
250: my ($dom,$lonidsdir,$params) = @_;
251: return () unless (ref($params) eq 'HASH');
252:
253: my $cid = $params->{'course'};
254: my $owner = $params->{'owner'};
255: my $token = $params->{'token'};
256: my ($ownername,$ownerdom) = split(/:/,$owner);
257: my $ownerhome = &Apache::lonnet::homeserver($ownername,$ownerdom);
258: return () if ($ownerhome eq 'no_host');
259: return () if ($cid eq '');
260: my ($cdom,$cnum) = split(/_/,$cid);
261: my $chome = &Apache::lonnet::homeserver($cnum,$cdom);
262: return () unless ($chome eq 'no_host');
263: my ($url,$code);
264: my $confname = &Apache::lonnet::get_domainconfiguser($cdom);
265: my %queuehash = &Apache::lonnet::get('courserequestqueue',
266: [$cnum.'_pending'],$cdom,$confname);
267: return () unless (ref($queuehash{$cnum.'_pending'}) eq 'HASH');
268: my ($crstype,$lonhost,$hostname,$handle);
269: $crstype = $queuehash{$cnum.'_pending'}{'crstype'};
270: $lonhost = $queuehash{$cnum.'_pending'}{'lonhost'};
271: if ($lonhost ne '') {
272: $hostname = &Apache::lonnet::hostname($lonhost);
273: }
274: my $savedtoken = $queuehash{$cnum.'_pending'}{'token'};
275: my $process;
276: if ($token ne '') {
277: if ($token eq $savedtoken) {
278: $process = 1;
279: }
280: }
281: return () unless ($process);
282:
283: my %domdefs = &Apache::lonnet::get_domain_defaults($cdom);
284: my ($logmsg,$newusermsg,$addresult,$enrollcount,$response,$keysmsg,%longroles,$code,
285: $dcname,$dcdom);
286: my $type = 'Course';
287: my $now = time;
288: if ($crstype eq 'community') {
289: $type = 'Community';
290: }
291: my @roles = &Apache::lonuserutils::roles_by_context('course','',$type);
292: foreach my $role (@roles) {
293: $longroles{$role}=&Apache::lonnet::plaintext($role,$type);
294: }
295: my @permissions = ('mau','ccc','cin','cta','cep','ccr','cst');
296: my %permissionflags = ();
297: &set_permissions(\%permissionflags,\@permissions);
298: my %domconfig = &Apache::lonnet::get_dom('configuration',['requestcourses'],$cdom);
299: if (ref($domconfig{'requestcourses'}) eq 'HASH') {
300: if (ref($domconfig{'requestcourses'}{'validation'}) eq 'HASH') {
301: if ($domconfig{'requestcourses'}{'validation'}{'dc'}) {
302: ($dcname,$dcdom) = split(/:/,$domconfig{'requestcourses'}{'validation'}{'dc'});
303: }
304: }
305: }
306: my %history = &Apache::lonnet::restore($cid,'courserequests',$ownerdom,$ownername);
307: if (ref($history{'details'}) eq 'HASH') {
308: my %reqhash = (
309: reqtime => $now,
310: crstype => $crstype,
311: details => $history{'details'},
312: );
313: my %customitems;
314: my $fullname = &Apache::loncommon::plainname($ownername,$ownerdom);
315: my $inprocess = &Apache::lonnet::auto_crsreq_update($cdom,$cnum,$crstype,'process',
316: $ownername,$ownerdom,$fullname,
317: $history{'details'}{'cdescr'});
318: if (ref($inprocess) eq 'HASH') {
319: foreach my $key (keys(%{$inprocess})) {
320: if (exists($history{'details'}{$key})) {
321: $customitems{$key} = $history{'details'}{$key};
322: }
323: }
324: }
325: &set_dc_env($dcname,$dcdom,$dcdom,$ownername,$ownerdom,$crstype);
326: my ($result,$postprocess) = &Apache::loncoursequeueadmin::course_creation($cdom,$cnum,
327: 'domain',$history{'details'},\$logmsg,\$newusermsg,
328: \$addresult,\$enrollcount,\$response,\$keysmsg,\%domdefs,
329: \%longroles,\$code,\%customitems);
330: &unset_dc_env($dcname,$dcdom,$ownername,$ownerdom,$crstype);
331: if ($result eq 'created') {
332: my $disposition = 'created';
333: my $reqstatus = 'created';
334: if (($code) || ((ref($postprocess) eq 'HASH') &&
335: (($postprocess->{'createdweb'}) || ($postprocess->{'createdmsg'})))) {
336: my $addmsg = [];
337: my $recipient = $ownername.':'.$ownerdom;
338: my $sender = $recipient;
339: if ($code) {
340: push(@{$addmsg},{
341: mt => 'Students can automatically select your course: "[_1]" by entering this code: [_2]',
342: args => [$history{'details'}{'cdescr'},$code],
343: });
344: }
345: if (ref($postprocess) eq 'HASH') {
346: if (ref($postprocess->{'createdmsg'}) eq 'ARRAY') {
347: foreach my $item (@{$postprocess->{'createdmsg'}}) {
348: if (ref($item) eq 'HASH') {
349: if ($item->{'mt'} ne '') {
350: push(@{$addmsg},$item);
351: }
352: }
353: }
354: }
355: }
356: if (scalar(@{$addmsg}) > 0) {
357: my $type = 'createdcrsreq';
358: if ($code) {
359: $type = 'uniquecode';
360: }
361: &Apache::loncoursequeueadmin::send_selfserve_notification($recipient,$addmsg,$cdom.'_'.$cnum,
362: $history{'details'}{'cdescr'},
363: $now,$type,$sender);
364: }
365: }
366: if ($code) {
367: $reqhash{'code'} = $code;
368: }
369: my $creationresult = 'created';
370: my ($storeresult,$updateresult) =
371: &Apache::loncoursequeueadmin::update_coursereq_status(\%reqhash,$cdom,
372: $cnum,$reqstatus,'request',$ownerdom,$ownername);
373: #
374: # check for session for this user
375: # if session, construct URL point at check for new roles.
376: #
377: if ($lonhost) {
378: my @hosts = &Apache::lonnet::current_machine_ids();
379: if (grep(/^\Q$lonhost\E$/,@hosts) && ($handle) && ($hostname)) {
380: if ($lonidsdir ne '') {
381: if (-e "$lonidsdir/$handle.id") {
382: my $protocol = $Apache::lonnet::protocol{$lonhost};
383: $protocol = 'http' if ($protocol ne 'https');
384: $url = $protocol.'://'.$hostname.'/adm/roles?state=doupdate';
385: }
386: }
387: }
388: #
389: # otherwise point at default portal, or if non specified, at /adm/login?querystring where
390: # querystring contains role=st./$cdom/$cnum
391: #
392: if ($url eq '') {
393: my %domdefaults = &Apache::lonnet::get_domain_defaults($cdom);
394: if ($domdefaults{'portal_def'}) {
395: $url = $domdefaults{'portal_def'};
396: } else {
397: my $chome = &Apache::lonnet::homeserver($cnum,$cdom);
398: my $hostname = &Apache::lonnet::hostname($chome);
399: my $protocol = $Apache::lonnet::protocol{$chome};
400: $protocol = 'http' if ($protocol ne 'https');
401: my $role = 'cc';
402: if ($crstype eq 'community') {
403: $role = 'co';
404: }
405: $url = $protocol.'://'.$hostname.'/adm/login?role='.$role.'./'.$cdom.'/'.$cnum;
406: }
407: }
408: }
409: }
410: }
411: &unset_permissions(\%permissionflags);
412: return ($url,$code);
413: }
414:
415: sub set_permissions {
416: my ($permissionflags,$permissions) = @_;
417: foreach my $allowtype (@{$permissions}) {
418: unless($env{"allowed.$allowtype"}) {
419: $env{"allowed.$allowtype"} = 'F';
420: $permissionflags->{$allowtype} = 1;
421: }
422: }
423: }
424:
425: sub unset_permissions {
426: my ($permissionflags) = @_;
427: foreach my $allowtype (keys(%{$permissionflags})) {
428: delete($env{"allowed.$allowtype"});
429: }
430: }
431:
432: sub set_dc_env {
433: my ($dcname,$dcdom,$defdom,$ownername,$ownerdom,$crstype) = @_;
434: $env{'user.name'} = $dcname;
435: $env{'user.domain'} = $dcdom;
436: $env{'user.home'} = &Apache::lonnet::homeserver($dcname,$dcdom);
437: if ($defdom ne '') {
438: $env{'request.role.domain'} = $defdom;
439: }
440: if (($dcname eq $ownername) && ($dcdom eq $ownerdom)) {
441: $env{'environment.canrequest.'.$crstype} = 1;
442: }
443: return;
444: }
445:
446: sub unset_dc_env {
447: my ($dcname,$dcdom,$ownername,$ownerdom,$crstype) = @_;
448: delete($env{'user.name'});
449: delete($env{'user.domain'});
450: delete($env{'user.home'});
451: if ($env{'request.role.domain'}) {
452: delete($env{'request.role.domain'});
453: }
454: if (($dcname eq $ownername) && ($dcdom eq $ownerdom)) {
455: delete($env{'environment.canrequest.'.$crstype});
456: }
457: return;
458: }
459:
460: =pod
461:
462: =back
463:
464: =cut
465:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to createpending.pl CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / cgi