#!/usr/bin/perl
$|=1;
# Script to complete processing of self-enrollment requests
# queued pending validation, when validated.
#
# $Id: enrollqueued.pl,v 1.4 2017/05/19 19:29:33 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
enrollqueued.pl
=head1 SYNOPSIS
CGI script to process queued self-enrollment request
and output URL which user will return to if enrollment
successful.
Data expected by enrollqueued.pl are the same fields
as included for a POST to the external validation site,
as specified in the domain configuration for
self-enrollment validation, which can be some or all of:
1. Unique six-character code
2. courseID (domain_coursenum)
3. student's username
4. student's domain
5. token
Either 1 or 2 are required, and 3 is required. If 4 is
not provided, the student's domain will be assumed to
be the same as the course (from 2).
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 of the validation server (as specified in
the domain configuration for self-enrollment).
Side effects are to print content (with text/plain
HTTP header). Content is the URL self-enrolling user
should use to access the course.
=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 $dom;
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 '') {
$dom = $possdom;
}
}
}
if ($dom eq '') {
if ($query->param('domain')) {
my $possdom = $query->param('domain');
$possdom =~ s/^\s+|\s+$//g;
if ($possdom =~ /^$LONCAPA::match_domain$/) {
my $domdesc = &Apache::lonnet::domain($possdom);
unless ($domdesc eq '') {
$dom = $possdom;
}
}
}
}
if ($dom eq '') {
$dom = &Apache::lonnet::default_login_domain();
}
if ($dom eq '') {
print &LONCAPA::loncgi::cgi_header('text/plain',1);
return;
}
if (!grep(/^\Q$dom\E$/,@okdoms)) {
print &LONCAPA::loncgi::cgi_header('text/plain',1);
return;
}
my %domconfig = &Apache::lonnet::get_dom('configuration',['selfenrollment'],$dom);
my $remote_ip = $ENV{'REMOTE_ADDR'};
my $allowed;
if (ref($domconfig{'selfenrollment'}) eq 'HASH') {
if (ref($domconfig{'selfenrollment'}{'validation'}) eq 'HASH') {
if ($domconfig{'selfenrollment'}{'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{'selfenrollment'}{'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{'selfenrollment'}) eq 'HASH') {
if (ref($domconfig{'selfenrollment'}{'validation'}) eq 'HASH') {
if (ref($domconfig{'selfenrollment'}{'validation'}{'fields'}) eq 'ARRAY') {
$numrequired = scalar(@{$domconfig{'selfenrollment'}{'validation'}{'fields'}});
foreach my $field (@{$domconfig{'selfenrollment'}{'validation'}{'fields'}}) {
$params{$field} = $query->param($field);
if ($field eq 'username') {
if ($query->param($field) =~ /^LONCAPA::match_username$/) {
$params{$field} = $query->param($field);
}
}
if ($field eq 'domain') {
if ($query->param($field) =~ /^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) =~ /^(official|unofficial|community|textbook|placement)$/) {
$params{$field} = $query->param($field);
}
}
if ($field eq 'uniquecode') {
if ($query->param($field) =~ /^\w{6}$/) {
$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) {
print(&process_enrollment($dom,$lonidsdir,\%params,\@fields));
}
} else {
print &LONCAPA::loncgi::cgi_header('text/plain',1);
}
return;
}
#############################################
#############################################
=pod
=item process_enrollment()
Inputs: $dom - domain of course for which enrollment is to be processed
$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_enrollment().
$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 self-enrollment validation.
Returns: $output - output to display.
If processing of the pending self-enrollment succeeds,
a URL is returned which may be used by the user to access
the course.
Description: Processes a pending self-enrollment request, given the username
domain, and courseID or six character code for the course.
=cut
#############################################
#############################################
sub process_enrollment {
my ($dom,$lonidsdir,$params) = @_;
return unless (ref($params) eq 'HASH');
my $cid = $params->{'course'};
my $uname = $params->{'username'};
my $udom = $params->{'domain'};
my $token = $params->{'token'};
my $uhome = &Apache::lonnet::homeserver($uname,$udom);
return if ($uhome eq 'no_host');
my %courseinfo;
if ($cid eq '') {
if ($params->{'uniquecode'}) {
my $uniquecode = $params->{'uniquecode'};
my $confname = $dom.'-domainconfig';
my %codes = &Apache::lonnet::get('uniquecodes',[$uniquecode],$dom,$confname);
if ($codes{$uniquecode}) {
$cid = $dom.'_'.$codes{$uniquecode};
}
}
}
return if ($cid eq '');
my $url;
if ($cid) {
%courseinfo = &Apache::lonnet::coursedescription($cid,{one_time => 1});
if ($courseinfo{'description'} ne '') {
my $cdom = $courseinfo{'domain'};
my $cnum = $courseinfo{'num'};
my %requesthash = &Apache::lonnet::get('selfenrollrequests',[$cid],$udom,$uname);
if (ref($requesthash{$cid}) eq 'HASH') {
if ($requesthash{$cid}{status} eq 'pending') {
my ($lonhost,$hostname,$handle);
$lonhost = $requesthash{$cid}{'lonhost'};
if ($lonhost ne '') {
$hostname = &Apache::lonnet::hostname($lonhost);
}
my $savedtoken = $requesthash{$cid}{'token'};
my $enroll = 1;
if ($token ne '') {
if ($token ne $savedtoken) {
$enroll = 0;
}
}
if ($enroll) {
my $handle = $requesthash{$cid}{'handle'};
my $usec = $courseinfo{'internal.selfenroll_section'};
my $access_start = $courseinfo{'internal.selfenroll_start_access'};
my $access_end = $courseinfo{'internal.selfenroll_end_access'};
my $limit = $courseinfo{'internal.selfenroll_limit'};
my $cap = $courseinfo{'internal.selfenroll_cap'};
my $notifylist = $courseinfo{'internal.selfenroll_notifylist'};
my ($stucounts,$idx,$classlist) = &get_student_counts($cdom,$cnum);
if (($limit eq 'allstudents') || ($limit eq 'selfenrolled')) {
if ($stucounts->{$limit} >= $cap) {
return;
}
}
$Apache::lonnet::env{'user.name'} = $uname;
$Apache::lonnet::env{'user.domain'} = $udom;
my $result =
&Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
undef,undef,undef,$usec,$access_end,$access_start,'selfenroll',
undef,$cid,1);
delete($Apache::lonnet::env{'user.name'});
delete($Apache::lonnet::env{'user.domain'});
if ($result eq 'ok') {
my %userrequest = (
$cdom.'_'.$cnum => {
timestamp => time,
section => $usec,
adjudicator => 'enrollqueued',
status => 'approved',
},
);
my $userresult =
&Apache::lonnet::put('selfenrollrequests',\%userrequest,$udom,$uname);
#
# check for session for this user
# if session, construct URL point at check for new roles.
#
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');
$url = $protocol.'://'.$hostname.'/adm/login?role=st./'.$cdom.'/'.$cnum;
}
}
}
}
}
}
}
}
return $url;
}
sub get_student_counts {
my ($cdom,$cnum) = @_;
my (%idx,%stucounts);
my $classlist = &Apache::loncoursedata::get_classlist($cdom,$cnum);
$idx{'type'} = &Apache::loncoursedata::CL_TYPE();
$idx{'status'} = &Apache::loncoursedata::CL_STATUS();
while (my ($student,$data) = each(%$classlist)) {
if (($data->[$idx{'status'}] eq 'Active') ||
($data->[$idx{'status'}] eq 'Future')) {
if ($data->[$idx{'type'}] eq 'selfenroll') {
$stucounts{'selfenroll'} ++;
}
$stucounts{'allstudents'} ++;
}
}
return (\%stucounts,\%idx,$classlist);
}
=pod
=back
=cut
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