#!/usr/bin/perl
$|=1;
# Script to complete processing of course/community requests
# for unofficial courses, textbook courses, communities and
# placement tests queued pending validation, once validated.
#
# $Id: createpending.pl,v 1.2 2016/08/17 14:35:57 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
# This file is part of the LearningOnline Network with CAPA (LON-CAPA).
#
# LON-CAPA is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# LON-CAPA is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with LON-CAPA; if not, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
#
# /home/httpd/html/adm/gpl.txt
#
# http://www.lon-capa.org/
#
#############################################
#############################################
=pod
=head1 NAME
createpending.pl
=head1 SYNOPSIS
CGI script to process pending course/community requests
and output URL which user will return to if course
creation successful.
Data expected by createpending.pl are the same fields
as included for a POST to the external validation site,
as specified in the domain configuration for
course request validation, which can be some or all of:
1. courseID (domain_coursenum)
2. requester's username:domain
3. course type
4. course description
Both 1 and 2 are required, whereas 3 and 4 are optional.
The data can be passed either in a query string or as
POSTed form variables.
=head1 Subroutines
=over 4
=cut
#############################################
#############################################
use strict;
use lib '/home/httpd/lib/perl/';
use LONCAPA::loncgi;
use Apache::lonnet;
use Apache::loncommon();
use Apache::lonuserutils();
use Apache::loncoursequeueadmin();
use Apache::lonlocal;
use LONCAPA;
use IO::Socket;
&main();
exit 0;
#############################################
#############################################
=pod
=item main()
Inputs: None
Returns: Nothing
Description: Main program. Determines if requesting IP is the IP
of the validation server. Side effect is to
print content (with text/plain HTTP header).
Content is URL course requester should use
to access the course, when course creation
is successful.
=cut
#############################################
#############################################
sub main {
my $query = CGI->new();
my @okdoms = &Apache::lonnet::current_machine_domains();
my $perlvar = &LONCAPA::Configuration::read_conf();
my $lonidsdir;
if (ref($perlvar) eq 'HASH') {
$lonidsdir = $perlvar->{'lonIDsDir'};
}
undef($perlvar);
my ($cdom,$cnum);
if ($query->param('course')) {
my $course = $query->param('course');
$course =~ s/^\s+|\s+$//g;
if ($course =~ /^($LONCAPA::match_domain)_($LONCAPA::match_courseid)$/) {
my $possdom = $1;
my $domdesc = &Apache::lonnet::domain($possdom);
unless ($domdesc eq '') {
$cdom = $possdom;
}
} else {
print &LONCAPA::loncgi::cgi_header('text/plain',1);
return;
}
}
if ($cdom eq '') {
print &LONCAPA::loncgi::cgi_header('text/plain',1);
return;
}
if (!grep(/^\Q$cdom\E$/,@okdoms)) {
print &LONCAPA::loncgi::cgi_header('text/plain',1);
return;
}
my %domconfig = &Apache::lonnet::get_dom('configuration',['requestcourses'],$cdom);
my $remote_ip = $ENV{'REMOTE_ADDR'};
my $allowed;
if (ref($domconfig{'requestcourses'}) eq 'HASH') {
if (ref($domconfig{'requestcourses'}{'validation'}) eq 'HASH') {
if ($domconfig{'requestcourses'}{'validation'}{'url'} =~ m{^https?://([^/]+)/}) {
my $ip = gethostbyname($1);
if ($ip ne '') {
my $validator_ip = inet_ntoa($ip);
if (($validator_ip ne '') && ($remote_ip eq $validator_ip)) {
$allowed = 1;
}
}
} elsif ($domconfig{'requestcourses'}{'validation'}{'url'} =~ m{^/}) {
if ($remote_ip ne '') {
if (($remote_ip eq '127.0.0.1') || ($remote_ip eq $ENV{'SERVER_ADDR'})) {
$allowed = 1;
}
}
}
}
}
my (%params,@fields,$numrequired);
if ($allowed) {
&Apache::lonlocal::get_language_handle();
my ($validreq,@fields);
if (ref($domconfig{'requestcourses'}) eq 'HASH') {
if (ref($domconfig{'requestcourses'}{'validation'}) eq 'HASH') {
if (ref($domconfig{'requestcourses'}{'validation'}{'fields'}) eq 'ARRAY') {
$numrequired = scalar(@{$domconfig{'requestcourses'}{'validation'}{'fields'}});
foreach my $field (@{$domconfig{'requestcourses'}{'validation'}{'fields'}}) {
$params{$field} = $query->param($field);
if ($field eq 'owner') {
if ($query->param($field) =~ /^(LONCAPA::match_username):($LONCAPA::match_domain)$$/) {
$params{$field} = $query->param($field);
}
}
if ($field eq 'course') {
if ($query->param($field) =~ /^(?:LONCAPA::match_domain)_(?:LONCAPA::match_courseid)$/) {
$params{$field} = $query->param($field);
}
}
if ($field eq 'coursetype') {
if ($query->param($field) =~ /^(unofficial|community|textbook|placement)$/) {
$params{$field} = $query->param($field);
}
}
if ($field eq 'description') {
$params{$field} = $query->param($field);
}
}
if ($numrequired == scalar(keys(%params))) {
$validreq = 1;
}
}
}
}
print &LONCAPA::loncgi::cgi_header('text/plain',1);
if ($validreq) {
$params{'token'} = $query->param('token');
my ($url,$code) = &process_courserequest($cdom,$lonidsdir,\%params);
if ($url) {
print("$url\n$code");
}
}
} else {
print &LONCAPA::loncgi::cgi_header('text/plain',1);
}
return;
}
#############################################
#############################################
=pod
=item process_courserequest()
Inputs: $dom - domain of course to be created
$lonidsdir - Path to directory containing session files for users.
Perl var lonIDsDir is read from loncapa_apache.conf
in &main() and passed as third arg to process_courserequest().
$params - references to hash of key=value pairs from input
(either query string or POSTed). Keys which will be
used are fields specified in domain configuration
for validation of pending unofficial courses, textbook courses,
communities and placement tests.
Returns: $url,$code - If processing of the pending course request succeeds,
a URL is returned which may be used by the requester to access
the new course. If a six character code was also set, that is
returned as a second item.
Description: Processes a pending course creation request, given the username
and domain of the requester and the courseID of the new course.
=cut
#############################################
#############################################
sub process_courserequest {
my ($dom,$lonidsdir,$params) = @_;
return () unless (ref($params) eq 'HASH');
my $cid = $params->{'course'};
my $owner = $params->{'owner'};
my $token = $params->{'token'};
my ($ownername,$ownerdom) = split(/:/,$owner);
my $ownerhome = &Apache::lonnet::homeserver($ownername,$ownerdom);
return () if ($ownerhome eq 'no_host');
return () if ($cid eq '');
my ($cdom,$cnum) = split(/_/,$cid);
my $chome = &Apache::lonnet::homeserver($cnum,$cdom);
return () unless ($chome eq 'no_host');
my ($url,$code);
my $confname = &Apache::lonnet::get_domainconfiguser($cdom);
my %queuehash = &Apache::lonnet::get('courserequestqueue',
[$cnum.'_pending'],$cdom,$confname);
return () unless (ref($queuehash{$cnum.'_pending'}) eq 'HASH');
my ($crstype,$lonhost,$hostname,$handle);
$crstype = $queuehash{$cnum.'_pending'}{'crstype'};
$lonhost = $queuehash{$cnum.'_pending'}{'lonhost'};
if ($lonhost ne '') {
$hostname = &Apache::lonnet::hostname($lonhost);
}
my $savedtoken = $queuehash{$cnum.'_pending'}{'token'};
my $process;
if ($token ne '') {
if ($token eq $savedtoken) {
$process = 1;
}
}
return () unless ($process);
my %domdefs = &Apache::lonnet::get_domain_defaults($cdom);
my ($logmsg,$newusermsg,$addresult,$enrollcount,$response,$keysmsg,%longroles,$code,
$dcname,$dcdom);
my $type = 'Course';
my $now = time;
if ($crstype eq 'community') {
$type = 'Community';
}
my @roles = &Apache::lonuserutils::roles_by_context('course','',$type);
foreach my $role (@roles) {
$longroles{$role}=&Apache::lonnet::plaintext($role,$type);
}
my @permissions = ('mau','ccc','cin','cta','cep','ccr','cst');
my %permissionflags = ();
&set_permissions(\%permissionflags,\@permissions);
my %domconfig = &Apache::lonnet::get_dom('configuration',['requestcourses'],$cdom);
if (ref($domconfig{'requestcourses'}) eq 'HASH') {
if (ref($domconfig{'requestcourses'}{'validation'}) eq 'HASH') {
if ($domconfig{'requestcourses'}{'validation'}{'dc'}) {
($dcname,$dcdom) = split(/:/,$domconfig{'requestcourses'}{'validation'}{'dc'});
}
}
}
my %history = &Apache::lonnet::restore($cid,'courserequests',$ownerdom,$ownername);
if (ref($history{'details'}) eq 'HASH') {
my %reqhash = (
reqtime => $now,
crstype => $crstype,
details => $history{'details'},
);
my %customitems;
my $fullname = &Apache::loncommon::plainname($ownername,$ownerdom);
my $inprocess = &Apache::lonnet::auto_crsreq_update($cdom,$cnum,$crstype,'process',
$ownername,$ownerdom,$fullname,
$history{'details'}{'cdescr'});
if (ref($inprocess) eq 'HASH') {
foreach my $key (keys(%{$inprocess})) {
if (exists($history{'details'}{$key})) {
$customitems{$key} = $history{'details'}{$key};
}
}
}
&set_dc_env($dcname,$dcdom,$dcdom,$ownername,$ownerdom,$crstype);
my ($result,$postprocess) = &Apache::loncoursequeueadmin::course_creation($cdom,$cnum,
'domain',$history{'details'},\$logmsg,\$newusermsg,
\$addresult,\$enrollcount,\$response,\$keysmsg,\%domdefs,
\%longroles,\$code,\%customitems);
&unset_dc_env($dcname,$dcdom,$ownername,$ownerdom,$crstype);
if ($result eq 'created') {
my $disposition = 'created';
my $reqstatus = 'created';
if (($code) || ((ref($postprocess) eq 'HASH') &&
(($postprocess->{'createdweb'}) || ($postprocess->{'createdmsg'})))) {
my $addmsg = [];
my $recipient = $ownername.':'.$ownerdom;
my $sender = $recipient;
if ($code) {
push(@{$addmsg},{
mt => 'Students can automatically select your course: "[_1]" by entering this code: [_2]',
args => [$history{'details'}{'cdescr'},$code],
});
}
if (ref($postprocess) eq 'HASH') {
if (ref($postprocess->{'createdmsg'}) eq 'ARRAY') {
foreach my $item (@{$postprocess->{'createdmsg'}}) {
if (ref($item) eq 'HASH') {
if ($item->{'mt'} ne '') {
push(@{$addmsg},$item);
}
}
}
}
}
if (scalar(@{$addmsg}) > 0) {
my $type = 'createdcrsreq';
if ($code) {
$type = 'uniquecode';
}
&Apache::loncoursequeueadmin::send_selfserve_notification($recipient,$addmsg,$cdom.'_'.$cnum,
$history{'details'}{'cdescr'},
$now,$type,$sender);
}
}
if ($code) {
$reqhash{'code'} = $code;
}
my $creationresult = 'created';
my ($storeresult,$updateresult) =
&Apache::loncoursequeueadmin::update_coursereq_status(\%reqhash,$cdom,
$cnum,$reqstatus,'request',$ownerdom,$ownername);
#
# check for session for this user
# if session, construct URL point at check for new roles.
#
if ($lonhost) {
my @hosts = &Apache::lonnet::current_machine_ids();
if (grep(/^\Q$lonhost\E$/,@hosts) && ($handle) && ($hostname)) {
if ($lonidsdir ne '') {
if (-e "$lonidsdir/$handle.id") {
my $protocol = $Apache::lonnet::protocol{$lonhost};
$protocol = 'http' if ($protocol ne 'https');
$url = $protocol.'://'.$hostname.'/adm/roles?state=doupdate';
}
}
}
#
# otherwise point at default portal, or if non specified, at /adm/login?querystring where
# querystring contains role=st./$cdom/$cnum
#
if ($url eq '') {
my %domdefaults = &Apache::lonnet::get_domain_defaults($cdom);
if ($domdefaults{'portal_def'}) {
$url = $domdefaults{'portal_def'};
} else {
my $chome = &Apache::lonnet::homeserver($cnum,$cdom);
my $hostname = &Apache::lonnet::hostname($chome);
my $protocol = $Apache::lonnet::protocol{$chome};
$protocol = 'http' if ($protocol ne 'https');
my $role = 'cc';
if ($crstype eq 'community') {
$role = 'co';
}
$url = $protocol.'://'.$hostname.'/adm/login?role='.$role.'./'.$cdom.'/'.$cnum;
}
}
}
}
}
&unset_permissions(\%permissionflags);
return ($url,$code);
}
sub set_permissions {
my ($permissionflags,$permissions) = @_;
foreach my $allowtype (@{$permissions}) {
unless($env{"allowed.$allowtype"}) {
$env{"allowed.$allowtype"} = 'F';
$permissionflags->{$allowtype} = 1;
}
}
}
sub unset_permissions {
my ($permissionflags) = @_;
foreach my $allowtype (keys(%{$permissionflags})) {
delete($env{"allowed.$allowtype"});
}
}
sub set_dc_env {
my ($dcname,$dcdom,$defdom,$ownername,$ownerdom,$crstype) = @_;
$env{'user.name'} = $dcname;
$env{'user.domain'} = $dcdom;
$env{'user.home'} = &Apache::lonnet::homeserver($dcname,$dcdom);
if ($defdom ne '') {
$env{'request.role.domain'} = $defdom;
}
if (($dcname eq $ownername) && ($dcdom eq $ownerdom)) {
$env{'environment.canrequest.'.$crstype} = 1;
}
return;
}
sub unset_dc_env {
my ($dcname,$dcdom,$ownername,$ownerdom,$crstype) = @_;
delete($env{'user.name'});
delete($env{'user.domain'});
delete($env{'user.home'});
if ($env{'request.role.domain'}) {
delete($env{'request.role.domain'});
}
if (($dcname eq $ownername) && ($dcdom eq $ownerdom)) {
delete($env{'environment.canrequest.'.$crstype});
}
return;
}
=pod
=back
=cut
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