Return to enrollqueued.pl CVS log

Up to [LON-CAPA] / loncom / cgi

- Fix incomplete sentence in documentation
- Fix some typos.

    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.3 2014/04/14 01:45:49 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: use IO::Socket;
   83: 
   84: &main();
   85: exit 0;
   86: 
   87: #############################################
   88: #############################################
   89: 
   90: =pod
   91: 
   92: =item main()
   93: 
   94: Inputs: None
   95: 
   96: Returns: Nothing
   97: 
   98: Description: Main program. Determines if requesting IP is the IP 
   99:              of the of the validation server (as specified in 
  100:              the domain configuration for self-enrollment).
  101:              Side effects are to print content (with text/plain 
  102:              HTTP header).  Content is the URL self-enrolling user
  103:              should use to access the course.
  104: 
  105: =cut
  106: 
  107: #############################################
  108: #############################################
  109: 
  110: sub main {
  111:     my $query = CGI->new();
  112: 
  113:     my @okdoms = &Apache::lonnet::current_machine_domains();
  114: 
  115:     my $perlvar = &LONCAPA::Configuration::read_conf();
  116:     my $lonidsdir;
  117:     if (ref($perlvar) eq 'HASH') {
  118:         $lonidsdir = $perlvar->{'lonIDsDir'};
  119:     }
  120:     undef($perlvar);
  121: 
  122:     my $dom;
  123:     if ($query->param('course')) {
  124:         my $course = $query->param('course'); 
  125:         $course =~ s/^\s+|\s+$//g;
  126:         if ($course =~ /^($LONCAPA::match_domain)_($LONCAPA::match_courseid)$/) {
  127:             my $possdom = $1;
  128:             my $domdesc = &Apache::lonnet::domain($possdom);
  129:             unless ($domdesc eq '') {
  130:                 $dom = $possdom;
  131:             }
  132:         }
  133:     }
  134: 
  135:     if ($dom eq '') {
  136:         if ($query->param('domain')) {
  137:             my $possdom = $query->param('domain');
  138:             $possdom =~ s/^\s+|\s+$//g;
  139:             if ($possdom =~ /^$LONCAPA::match_domain$/) {
  140:                 my $domdesc = &Apache::lonnet::domain($possdom);
  141:                 unless ($domdesc eq '') {
  142:                     $dom = $possdom;
  143:                 }
  144:             }
  145:         }
  146:     }
  147: 
  148:     if ($dom eq '') {
  149:         $dom = &Apache::lonnet::default_login_domain();
  150:     }
  151: 
  152:     if ($dom eq '') {
  153:         print &LONCAPA::loncgi::cgi_header('text/plain',1);
  154:         return;
  155:     }
  156: 
  157:     if (!grep(/^\Q$dom\E$/,@okdoms)) {
  158:         print &LONCAPA::loncgi::cgi_header('text/plain',1);
  159:         return;
  160:     }
  161: 
  162:     my %domconfig = &Apache::lonnet::get_dom('configuration',['selfenrollment'],$dom);
  163:     my $remote_ip = $ENV{'REMOTE_ADDR'};
  164:     my $allowed;
  165: 
  166:     if (ref($domconfig{'selfenrollment'}) eq 'HASH') {
  167:         if (ref($domconfig{'selfenrollment'}{'validation'}) eq 'HASH') {
  168:             if ($domconfig{'selfenrollment'}{'validation'}{'url'} =~ m{^https?://([^/]+)/}) {
  169:                 my $ip = gethostbyname($1);
  170:                 if ($ip ne '') {
  171:                     my $validator_ip = inet_ntoa($ip);
  172:                     if (($validator_ip ne '') && ($remote_ip eq $validator_ip)) {
  173:                         $allowed = 1;
  174:                     }
  175:                 }
  176:             } elsif ($domconfig{'selfenrollment'}{'validation'}{'url'} =~ m{^/}) {
  177:                 if ($remote_ip ne '') {
  178:                     if (($remote_ip eq '127.0.0.1') || ($remote_ip eq $ENV{'SERVER_ADDR'})) {
  179:                         $allowed = 1;
  180:                     }
  181:                 }
  182:             }
  183:         }
  184:     }
  185: 
  186:     my (%params,@fields,$numrequired);
  187:     if ($allowed) {
  188:         &Apache::lonlocal::get_language_handle();
  189:         my ($validreq,@fields);
  190:         if (ref($domconfig{'selfenrollment'}) eq 'HASH') {
  191:             if (ref($domconfig{'selfenrollment'}{'validation'}) eq 'HASH') {
  192:                 if (ref($domconfig{'selfenrollment'}{'validation'}{'fields'}) eq 'ARRAY') {
  193:                     $numrequired = scalar(@{$domconfig{'selfenrollment'}{'validation'}{'fields'}});
  194:                     foreach my $field (@{$domconfig{'selfenrollment'}{'validation'}{'fields'}}) {
  195:                         $params{$field} = $query->param($field);
  196:                         if ($field eq 'username') {
  197:                             if ($query->param($field) =~ /^LONCAPA::match_username$/) {
  198:                                 $params{$field} = $query->param($field);
  199:                             }
  200:                         }
  201:                         if ($field eq 'domain') {
  202:                             if ($query->param($field) =~ /^LONCAPA::match_domain$/) {
  203:                                 $params{$field} = $query->param($field);
  204:                             }
  205:                         }
  206:                         if ($field eq 'course') {
  207:                             if ($query->param($field) =~ /^(?:LONCAPA::match_domain)_(?:LONCAPA::match_courseid)$/) {
  208:                                 $params{$field} = $query->param($field);
  209:                             }
  210:                         }
  211:                         if ($field eq 'coursetype') {
  212:                             if ($query->param($field) =~ /^(official|unofficial|community|textbook)$/) {
  213:                                 $params{$field} = $query->param($field);
  214:                             }
  215:                         }
  216:                         if ($field eq 'uniquecode') {
  217:                             if ($query->param($field) =~ /^\w{6}$/) {
  218:                                 $params{$field} = $query->param($field);
  219:                             }
  220:                         }
  221:                         if ($field eq 'description') {
  222:                             $params{$field} = $query->param($field);
  223:                         }
  224:                     }
  225:                     if ($numrequired == scalar(keys(%params))) {
  226:                         $validreq = 1;
  227:                     }
  228:                 }
  229:             }
  230:         }
  231:         print &LONCAPA::loncgi::cgi_header('text/plain',1);
  232:         if ($validreq) {
  233:             print(&process_enrollment($dom,$lonidsdir,\%params,\@fields));
  234:         }
  235:     } else {
  236:         print &LONCAPA::loncgi::cgi_header('text/plain',1);
  237:     }
  238:     return;
  239: }
  240: 
  241: #############################################
  242: #############################################
  243: 
  244: =pod
  245: 
  246: =item process_enrollment()
  247: 
  248: Inputs: $dom - domain of course for which enrollment is to be processed
  249:         $lonidsdir - Path to directory containing session files for users.
  250:                      Perl var lonIDsDir is read from loncapa_apache.conf
  251:                      in &main() and passed as third arg to process_enrollment().
  252:         $params - references to hash of key=value pairs from input
  253:                   (either query string or POSTed). Keys which will be
  254:                   used are fields specified in domain configuration
  255:                   for self-enrollment validation.
  256: 
  257: Returns: $output - output to display.
  258:                    If processing of the pending self-enrollment succeeds,
  259:                    a URL is returned which may be used by the user to access 
  260:                    the course.
  261: 
  262: Description: Processes a pending self-enrollment request, given the username
  263:              domain, and courseID or six character code for the course.
  264: 
  265: =cut
  266: 
  267: #############################################
  268: #############################################
  269: 
  270: sub process_enrollment {
  271:     my ($dom,$lonidsdir,$params) = @_;
  272:     return unless (ref($params) eq 'HASH');
  273: 
  274:     my $cid = $params->{'course'};
  275:     my $uname = $params->{'username'};
  276:     my $udom = $params->{'domain'};
  277:     my $token = $params->{'token'};
  278:     my $uhome = &Apache::lonnet::homeserver($uname,$udom);
  279:     return if ($uhome eq 'no_host');
  280:     my %courseinfo;
  281:     if ($cid eq '') {
  282:         if ($params->{'uniquecode'}) {
  283:             my $uniquecode = $params->{'uniquecode'}; 
  284:             my $confname = $dom.'-domainconfig';
  285:             my %codes = &Apache::lonnet::get('uniquecodes',[$uniquecode],$dom,$confname);
  286:             if ($codes{$uniquecode}) {
  287:                 $cid = $dom.'_'.$codes{$uniquecode};
  288:             }
  289:         }
  290:     }
  291:     return if ($cid eq '');
  292:     my $url;
  293:     if ($cid) {
  294:         %courseinfo = &Apache::lonnet::coursedescription($cid,{one_time => 1});
  295:         if ($courseinfo{'description'} ne '') {
  296:             my $cdom = $courseinfo{'domain'};
  297:             my $cnum = $courseinfo{'num'};
  298:             my %requesthash = &Apache::lonnet::get('selfenrollrequests',[$cid],$udom,$uname);
  299:             if (ref($requesthash{$cid}) eq 'HASH') {
  300:                 if ($requesthash{$cid}{status} eq 'pending') {
  301:                     my ($lonhost,$hostname,$handle);
  302:                     $lonhost = $requesthash{$cid}{'lonhost'};
  303:                     if ($lonhost ne '') {
  304:                         $hostname = &Apache::lonnet::hostname($lonhost);
  305:                     }
  306:                     my $savedtoken = $requesthash{$cid}{'token'};
  307:                     my $enroll = 1;
  308:                     if ($token ne '') {
  309:                         if ($token ne $savedtoken) {
  310:                             $enroll = 0;
  311:                         }
  312:                     }
  313:                     if ($enroll) {
  314:                         my $handle = $requesthash{$cid}{'handle'}; 
  315:                         my $usec = $courseinfo{'internal.selfenroll_section'};
  316:                         my $access_start = $courseinfo{'internal.selfenroll_start_access'};
  317:                         my $access_end = $courseinfo{'internal.selfenroll_end_access'};
  318:                         my $limit = $courseinfo{'internal.selfenroll_limit'};
  319:                         my $cap = $courseinfo{'internal.selfenroll_cap'};
  320:                         my $notifylist = $courseinfo{'internal.selfenroll_notifylist'};
  321:                         my ($stucounts,$idx,$classlist) = &get_student_counts($cdom,$cnum);
  322:                         if (($limit eq 'allstudents') || ($limit eq 'selfenrolled')) {
  323:                             if ($stucounts->{$limit} >= $cap) {
  324:                                 return;
  325:                             }
  326:                         }
  327:                         $Apache::lonnet::env{'user.name'} = $uname;
  328:                         $Apache::lonnet::env{'user.domain'} = $udom;
  329:                         my $result =
  330:                             &Apache::lonnet::modify_student_enrollment($udom,$uname,undef,undef,
  331:                                 undef,undef,undef,$usec,$access_end,$access_start,'selfenroll',
  332:                                 undef,$cid,1);
  333:                         delete($Apache::lonnet::env{'user.name'});
  334:                         delete($Apache::lonnet::env{'user.domain'});
  335:                         if ($result eq 'ok') {
  336:                             my %userrequest = (
  337:                                 $cdom.'_'.$cnum => {
  338:                                                      timestamp   => time,
  339:                                                      section     => $usec,
  340:                                                      adjudicator => 'enrollqueued',
  341:                                                      status      => 'approved',
  342:                                                    },
  343:                             );
  344:                             my $userresult =
  345:                                 &Apache::lonnet::put('selfenrollrequests',\%userrequest,$udom,$uname);
  346: #
  347: # check for session for this user
  348: # if session, construct URL point at check for new roles.
  349: #
  350:                             my @hosts = &Apache::lonnet::current_machine_ids();
  351:                             if (grep(/^\Q$lonhost\E$/,@hosts) && ($handle) && ($hostname)) {
  352:                                 if ($lonidsdir ne '') {
  353:                                     if (-e "$lonidsdir/$handle.id") {
  354:                                         my $protocol = $Apache::lonnet::protocol{$lonhost};
  355:                                         $protocol = 'http' if ($protocol ne 'https');
  356:                                         $url = $protocol.'://'.$hostname.'/adm/roles?state=doupdate';
  357:                                     }
  358:                                 }
  359:                             }
  360:          
  361: #
  362: # otherwise point at default portal, or if non specified, at /adm/login?querystring where 
  363: # querystring contains role=st./$cdom/$cnum
  364: #
  365:                             if ($url eq '') {
  366:                                 my %domdefaults = &Apache::lonnet::get_domain_defaults($cdom);
  367:                                 if ($domdefaults{'portal_def'}) {
  368:                                     $url = $domdefaults{'portal_def'};
  369:                                 } else {
  370:                                     my $chome = &Apache::lonnet::homeserver($cnum,$cdom);
  371:                                     my $hostname = &Apache::lonnet::hostname($chome);
  372:                                     my $protocol = $Apache::lonnet::protocol{$chome};
  373:                                     $protocol = 'http' if ($protocol ne 'https');
  374:                                     $url = $protocol.'://'.$hostname.'/adm/login?role=st./'.$cdom.'/'.$cnum;
  375:                                 }
  376:                             }
  377:                         }
  378:                     }
  379:                 }
  380:             }
  381:         }
  382:     }
  383:     return $url;
  384: }
  385: 
  386: sub get_student_counts {
  387:     my ($cdom,$cnum) = @_;
  388:     my (%idx,%stucounts);
  389:     my $classlist = &Apache::loncoursedata::get_classlist($cdom,$cnum);
  390:     $idx{'type'} = &Apache::loncoursedata::CL_TYPE();
  391:     $idx{'status'} = &Apache::loncoursedata::CL_STATUS();
  392:     while (my ($student,$data) = each(%$classlist)) {
  393:         if (($data->[$idx{'status'}] eq 'Active') ||
  394:             ($data->[$idx{'status'}] eq 'Future')) {
  395:             if ($data->[$idx{'type'}] eq 'selfenroll') {
  396:                 $stucounts{'selfenroll'} ++;
  397:             }
  398:             $stucounts{'allstudents'} ++;
  399:         }
  400:     }
  401:     return (\%stucounts,\%idx,$classlist);
  402: }
  403: 
  404: 
  405: =pod
  406: 
  407: =back
  408: 
  409: =cut
  410: