Return to enrollqueued.pl CVS log

Up to [LON-CAPA] / loncom / cgi

- Self-enrollment of validated requests
  - Temporarly set username and domain of self-enrolling user in
    %Apache::lonnet::env so lonnet::asignrole() will not reject attempt to
    add student role.
  - Support case where validator script is on same server as LON-CAPA instance.
  - Fix IP checking for case where POST to enrollqueued.pl comes from
    server specified in domain config for self-enrollment validation server.

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