Annotation of loncom/cgi/enrollqueued.pl, revision 1.3

1.1       raeburn     1: #!/usr/bin/perl
                      2: $|=1;
                      3: # Script to complete processing of self-enrollment requests
                      4: # queued pending validation, when validated.
                      5: #  
1.3     ! raeburn     6: # $Id: enrollqueued.pl,v 1.2 2014/04/05 22:42:33 raeburn Exp $
1.1       raeburn     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;
1.2       raeburn    82: use IO::Socket;
1.1       raeburn    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 
1.3     ! raeburn    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.
1.1       raeburn   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?://([^/]+)/}) {
1.2       raeburn   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:                     }
1.1       raeburn   181:                 }
                    182:             }
                    183:         }
                    184:     }
1.2       raeburn   185: 
1.1       raeburn   186:     my (%params,@fields,$numrequired);
1.2       raeburn   187:     if ($allowed) {
1.1       raeburn   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') {
1.2       raeburn   193:                     $numrequired = scalar(@{$domconfig{'selfenrollment'}{'validation'}{'fields'}});
1.1       raeburn   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') {
1.3     ! raeburn   202:                             if ($query->param($field) =~ /^LONCAPA::match_domain$/) {
1.1       raeburn   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:                         }
1.2       raeburn   221:                         if ($field eq 'description') {
                    222:                             $params{$field} = $query->param($field);
                    223:                         }
1.1       raeburn   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);
1.3     ! raeburn   279:     return if ($uhome eq 'no_host');
1.1       raeburn   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'};
1.2       raeburn   303:                     if ($lonhost ne '') {
1.1       raeburn   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:                         }
1.2       raeburn   327:                         $Apache::lonnet::env{'user.name'} = $uname;
                    328:                         $Apache::lonnet::env{'user.domain'} = $udom;
1.1       raeburn   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);
1.2       raeburn   333:                         delete($Apache::lonnet::env{'user.name'});
                    334:                         delete($Apache::lonnet::env{'user.domain'});
1.1       raeburn   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)) {
1.2       raeburn   352:                                 if ($lonidsdir ne '') {
1.1       raeburn   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:                             }
1.2       raeburn   360:          
1.1       raeburn   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: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>