Return to enrollqueued.pl CVS log

Up to [LON-CAPA] / loncom / cgi

- Bug 6808. New course container -- "Placement" for Placement Tests.

#!/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