Return to enrollqueued.pl CVS log

Up to [LON-CAPA] / loncom / cgi

- CGI script to process a self-enrollment request which had been queued,
  pending validation.
  - Script requires values for fields specified in domain configuration
    for self-enrollment validation.
  - Intended to support validation of self-enrollment requests on a
    third party system/server which handles payment etc.

    1: #!/usr/bin/perl
    2: $|=1;
    3: # Script to complete processing of self-enrollment requests
    4: # queued pending validation, when validated.
    5: #  
    6: # $Id: enrollqueued.pl,v 1.1 2014/04/01 21:39:18 raeburn Exp $
    7: #
    8: # Copyright Michigan State University Board of Trustees
    9: #
   10: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
   11: #
   12: # LON-CAPA is free software; you can redistribute it and/or modify
   13: # it under the terms of the GNU General Public License as published by
   14: # the Free Software Foundation; either version 2 of the License, or
   15: # (at your option) any later version.
   16: #
   17: # LON-CAPA is distributed in the hope that it will be useful,
   18: # but WITHOUT ANY WARRANTY; without even the implied warranty of
   19: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   20: # GNU General Public License for more details.
   21: #
   22: # You should have received a copy of the GNU General Public License
   23: # along with LON-CAPA; if not, write to the Free Software
   24: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   25: #
   26: # /home/httpd/html/adm/gpl.txt
   27: #
   28: # http://www.lon-capa.org/
   29: #
   30: #############################################
   31: #############################################
   32: 
   33: =pod
   34: 
   35: =head1 NAME
   36: 
   37: enrollqueued.pl
   38: 
   39: =head1 SYNOPSIS
   40: 
   41: CGI script to process queued self-enrollment request 
   42: and output URL which user will return to if enrollment
   43: successful.   
   44: 
   45: Data expected by enrollqueued.pl are the same fields
   46: as included for a POST to the external validation site,
   47: as specified in the domain configuration for
   48: self-enrollment validation, which can be some or all of: 
   49: 
   50: 1. Unique six-character code
   51: 2. courseID (domain_coursenum)
   52: 3. student's username
   53: 4. student's domain
   54: 5. token
   55: 
   56: Either 1 or 2 are required, and 3 is required. If 4 is
   57: not provided, the student's domain will be assumed to
   58: be the same as the course (from 2).
   59: 
   60: The data can be passed either in a query string or as
   61: POSTed form variables.
   62: 
   63: =head1 Subroutines
   64: 
   65: =over 4
   66: 
   67: =cut
   68: 
   69: #############################################
   70: #############################################
   71: 
   72: use strict;
   73: 
   74: use lib '/home/httpd/lib/perl/';
   75: use LONCAPA::loncgi;
   76: use Apache::lonnet();
   77: use Apache::loncommon();
   78: use Apache::lonuserutils();
   79: use Apache::loncoursequeueadmin();
   80: use Apache::lonlocal;
   81: use LONCAPA;
   82: 
   83: &main();
   84: exit 0;
   85: 
   86: #############################################
   87: #############################################
   88: 
   89: =pod
   90: 
   91: =item main()
   92: 
   93: Inputs: None
   94: 
   95: Returns: Nothing
   96: 
   97: Description: Main program. Determines if requesting IP is the IP 
   98:              of the server enrollqueued.pl. Side effects
   99:              prints content (with text/plain HTTP header).
  100:              Content is URL self-enrolling user should user
  101:              to access the course. 
  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 $dom;
  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:                 $dom = $possdom;
  129:             }
  130:         }
  131:     }
  132: 
  133:     if ($dom eq '') {
  134:         if ($query->param('domain')) {
  135:             my $possdom = $query->param('domain');
  136:             $possdom =~ s/^\s+|\s+$//g;
  137:             if ($possdom =~ /^$LONCAPA::match_domain$/) {
  138:                 my $domdesc = &Apache::lonnet::domain($possdom);
  139:                 unless ($domdesc eq '') {
  140:                     $dom = $possdom;
  141:                 }
  142:             }
  143:         }
  144:     }
  145: 
  146:     if ($dom eq '') {
  147:         $dom = &Apache::lonnet::default_login_domain();
  148:     }
  149: 
  150:     if ($dom eq '') {
  151:         print &LONCAPA::loncgi::cgi_header('text/plain',1);
  152:         return;
  153:     }
  154: 
  155:     if (!grep(/^\Q$dom\E$/,@okdoms)) {
  156:         print &LONCAPA::loncgi::cgi_header('text/plain',1);
  157:         return;
  158:     }
  159: 
  160:     my %domconfig = &Apache::lonnet::get_dom('configuration',['selfenrollment'],$dom);
  161:     my $remote_ip = $ENV{'REMOTE_ADDR'};
  162:     my $allowed;
  163: 
  164:     if (ref($domconfig{'selfenrollment'}) eq 'HASH') {
  165:         if (ref($domconfig{'selfenrollment'}{'validation'}) eq 'HASH') {
  166:             if ($domconfig{'selfenrollment'}{'validation'}{'url'} =~ m{^https?://([^/]+)/}) {
  167:                 my $validator_ip = gethostbyname($1);
  168:                 if (($validator_ip ne '') && ($remote_ip eq $validator_ip)) {
  169:                     $allowed = 1;
  170:                 }
  171:             }
  172:         }
  173:     }
  174:     my (%params,@fields,$numrequired);
  175:     if ($allowed ne '') {
  176:         &Apache::lonlocal::get_language_handle();
  177:         my ($validreq,@fields);
  178:         if (ref($domconfig{'selfenrollment'}) eq 'HASH') {
  179:             if (ref($domconfig{'selfenrollment'}{'validation'}) eq 'HASH') {
  180:                 if (ref($domconfig{'selfenrollment'}{'validation'}{'fields'}) eq 'ARRAY') {
  181:                     $numrequired = @fields;
  182:                     foreach my $field (@{$domconfig{'selfenrollment'}{'validation'}{'fields'}}) {
  183:                         $params{$field} = $query->param($field);
  184:                         if ($field eq 'username') {
  185:                             if ($query->param($field) =~ /^LONCAPA::match_username$/) {
  186:                                 $params{$field} = $query->param($field);
  187:                             }
  188:                         }
  189:                         if ($field eq 'domain') {
  190:                             if ($query->param($field) =~ /^LONCAPA::match_username$/) {
  191:                                 $params{$field} = $query->param($field);
  192:                             }
  193:                         }
  194:                         if ($field eq 'course') {
  195:                             if ($query->param($field) =~ /^(?:LONCAPA::match_domain)_(?:LONCAPA::match_courseid)$/) {
  196:                                 $params{$field} = $query->param($field);
  197:                             }
  198:                         }
  199:                         if ($field eq 'coursetype') {
  200:                             if ($query->param($field) =~ /^(official|unofficial|community|textbook)$/) {
  201:                                 $params{$field} = $query->param($field);
  202:                             }
  203:                         }
  204:                         if ($field eq 'uniquecode') {
  205:                             if ($query->param($field) =~ /^\w{6}$/) {
  206:                                 $params{$field} = $query->param($field);
  207:                             }
  208:                         }
  209:                     }
  210:                     if ($numrequired == scalar(keys(%params))) {
  211:                         $validreq = 1;
  212:                     }
  213:                 }
  214:             }
  215:         }
  216:         print &LONCAPA::loncgi::cgi_header('text/plain',1);
  217:         if ($validreq) {
  218:             print(&process_enrollment($dom,$lonidsdir,\%params,\@fields));
  219:         }
  220:     } else {
  221:         print &LONCAPA::loncgi::cgi_header('text/plain',1);
  222:     }
  223:     return;
  224: }
  225: 
  226: #############################################
  227: #############################################
  228: 
  229: =pod
  230: 
  231: =item process_enrollment()
  232: 
  233: Inputs: $dom - domain of course for which enrollment is to be processed
  234:         $lonidsdir - Path to directory containing session files for users.
  235:                      Perl var lonIDsDir is read from loncapa_apache.conf
  236:                      in &main() and passed as third arg to process_enrollment().
  237:         $params - references to hash of key=value pairs from input
  238:                   (either query string or POSTed). Keys which will be
  239:                   used are fields specified in domain configuration
  240:                   for self-enrollment validation.
  241: 
  242: Returns: $output - output to display.
  243:                    If processing of the pending self-enrollment succeeds,
  244:                    a URL is returned which may be used by the user to access 
  245:                    the course.
  246: 
  247: Description: Processes a pending self-enrollment request, given the username
  248:              domain, and courseID or six character code for the course.
  249: 
  250: =cut
  251: 
  252: #############################################
  253: #############################################
  254: 
  255: sub process_enrollment {
  256:     my ($dom,$lonidsdir,$params) = @_;
  257:     return unless (ref($params) eq 'HASH');
  258: 
  259:     my $cid = $params->{'course'};
  260:     my $uname = $params->{'username'};
  261:     my $udom = $params->{'domain'};
  262:     my $token = $params->{'token'};
  263:     my $uhome = &Apache::lonnet::homeserver($uname,$udom);
  264:     return if ($uhome eq 'nohost');
  265:     my %courseinfo;
  266:     if ($cid eq '') {
  267:         if ($params->{'uniquecode'}) {
  268:             my $uniquecode = $params->{'uniquecode'}; 
  269:             my $confname = $dom.'-domainconfig';
  270:             my %codes = &Apache::lonnet::get('uniquecodes',[$uniquecode],$dom,$confname);
  271:             if ($codes{$uniquecode}) {
  272:                 $cid = $dom.'_'.$codes{$uniquecode};
  273:             }
  274:         }
  275:     }
  276:     return if ($cid eq '');
  277:     my $url;
  278:     if ($cid) {
  279:         %courseinfo = &Apache::lonnet::coursedescription($cid,{one_time => 1});
  280:         if ($courseinfo{'description'} ne '') {
  281:             my $cdom = $courseinfo{'domain'};
  282:             my $cnum = $courseinfo{'num'};
  283:             my %requesthash = &Apache::lonnet::get('selfenrollrequests',[$cid],$udom,$uname);
  284:             if (ref($requesthash{$cid}) eq 'HASH') {
  285:                 if ($requesthash{$cid}{status} eq 'pending') {
  286:                     my ($lonhost,$hostname,$handle);
  287:                     $lonhost = $requesthash{$cid}{'lonhost'};
  288:                     if ($lonhost eq '') {
  289:                         $hostname = &Apache::lonnet::hostname($lonhost);
  290:                     }
  291:                     my $savedtoken = $requesthash{$cid}{'token'};
  292:                     my $enroll = 1;
  293:                     if ($token ne '') {
  294:                         if ($token ne $savedtoken) {
  295:                             $enroll = 0;
  296:                         }
  297:                     }
  298:                     if ($enroll) {
  299:                         my $handle = $requesthash{$cid}{'handle'}; 
  300:                         my $usec = $courseinfo{'internal.selfenroll_section'};
  301:                         my $access_start = $courseinfo{'internal.selfenroll_start_access'};
  302:                         my $access_end = $courseinfo{'internal.selfenroll_end_access'};
  303:                         my $limit = $courseinfo{'internal.selfenroll_limit'};
  304:                         my $cap = $courseinfo{'internal.selfenroll_cap'};
  305:                         my $notifylist = $courseinfo{'internal.selfenroll_notifylist'};
  306:                         my ($stucounts,$idx,$classlist) = &get_student_counts($cdom,$cnum);
  307:                         if (($limit eq 'allstudents') || ($limit eq 'selfenrolled')) {
  308:                             if ($stucounts->{$limit} >= $cap) {
  309:                                 return;
  310:                             }
  311:                         }
  312:                         my $result =
  313:                             &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
  314:                                 undef,undef,undef,$usec,$access_end,$access_start,'selfenroll',
  315:                                 undef,$cid,1);
  316:                         if ($result eq 'ok') {
  317:                             my %userrequest = (
  318:                                 $cdom.'_'.$cnum => {
  319:                                                      timestamp   => time,
  320:                                                      section     => $usec,
  321:                                                      adjudicator => 'enrollqueued',
  322:                                                      status      => 'approved',
  323:                                                    },
  324:                             );
  325:                             my $userresult =
  326:                                 &Apache::lonnet::put('selfenrollrequests',\%userrequest,$udom,$uname);
  327: #
  328: # check for session for this user
  329: # if session, construct URL point at check for new roles.
  330: #
  331:                             my @hosts = &Apache::lonnet::current_machine_ids();
  332:                             if (grep(/^\Q$lonhost\E$/,@hosts) && ($handle) && ($hostname)) {
  333:                                 if ($lonidsdir ne '') {    
  334:                                     if (-e "$lonidsdir/$handle.id") {
  335:                                         my $protocol = $Apache::lonnet::protocol{$lonhost};
  336:                                         $protocol = 'http' if ($protocol ne 'https');
  337:                                         $url = $protocol.'://'.$hostname.'/adm/roles?state=doupdate';
  338:                                     }
  339:                                 }
  340:                             }
  341: #
  342: # otherwise point at default portal, or if non specified, at /adm/login?querystring where 
  343: # querystring contains role=st./$cdom/$cnum
  344: #
  345:                             if ($url eq '') {
  346:                                 my %domdefaults = &Apache::lonnet::get_domain_defaults($cdom);
  347:                                 if ($domdefaults{'portal_def'}) {
  348:                                     $url = $domdefaults{'portal_def'};
  349:                                 } else {
  350:                                     my $chome = &Apache::lonnet::homeserver($cnum,$cdom);
  351:                                     my $hostname = &Apache::lonnet::hostname($chome);
  352:                                     my $protocol = $Apache::lonnet::protocol{$chome};
  353:                                     $protocol = 'http' if ($protocol ne 'https');
  354:                                     $url = $protocol.'://'.$hostname.'/adm/login?role=st./'.$cdom.'/'.$cnum;
  355:                                 }
  356:                             }
  357:                         }
  358:                     }
  359:                 }
  360:             }
  361:         }
  362:     }
  363:     return $url;
  364: }
  365: 
  366: sub get_student_counts {
  367:     my ($cdom,$cnum) = @_;
  368:     my (%idx,%stucounts);
  369:     my $classlist = &Apache::loncoursedata::get_classlist($cdom,$cnum);
  370:     $idx{'type'} = &Apache::loncoursedata::CL_TYPE();
  371:     $idx{'status'} = &Apache::loncoursedata::CL_STATUS();
  372:     while (my ($student,$data) = each(%$classlist)) {
  373:         if (($data->[$idx{'status'}] eq 'Active') ||
  374:             ($data->[$idx{'status'}] eq 'Future')) {
  375:             if ($data->[$idx{'type'}] eq 'selfenroll') {
  376:                 $stucounts{'selfenroll'} ++;
  377:             }
  378:             $stucounts{'allstudents'} ++;
  379:         }
  380:     }
  381:     return (\%stucounts,\%idx,$classlist);
  382: }
  383: 
  384: 
  385: =pod
  386: 
  387: =back
  388: 
  389: =cut
  390: