Annotation of loncom/cgi/enrollqueued.pl, revision 1.1
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: #
! 6: # $Id: enrollqueued.pl,v 1.1 2014/03/30 22:40:44 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:
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/back.gif){kind=icon}
Return to enrollqueued.pl CVS log ![[TXT]](/icons/text.gif){kind=icon}
![[DIR]](/icons/dir.gif){kind=icon}
Up to [LON-CAPA] / loncom / cgi