Annotation of loncom/cgi/createpending.pl, revision 1.1
1.1 ! raeburn 1: #!/usr/bin/perl
! 2: $|=1;
! 3: # Script to complete processing of course/community requests
! 4: # for unofficial courses, textbook courses and communities
! 5: # queued pending validation, once validated.
! 6: #
! 7: # $Id: createpending.pl,v 1.1 2014/04/13 22:42:33 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)$/) {
! 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: and communities.
! 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