Annotation of loncom/auth/lonacc.pm, revision 1.159.2.4

1.1       albertel    1: # The LearningOnline Network
                      2: # Cookie Based Access Handler
1.22      www         3: #
1.159.2.4! raeburn     4: # $Id: lonacc.pm,v 1.159.2.3 2016/08/07 20:49:37 raeburn Exp $
1.22      www         5: #
                      6: # Copyright Michigan State University Board of Trustees
                      7: #
                      8: # This file is part of the LearningOnline Network with CAPA (LON-CAPA).
                      9: #
                     10: # LON-CAPA is free software; you can redistribute it and/or modify
                     11: # it under the terms of the GNU General Public License as published by
                     12: # the Free Software Foundation; either version 2 of the License, or
                     13: # (at your option) any later version.
                     14: #
                     15: # LON-CAPA is distributed in the hope that it will be useful,
                     16: # but WITHOUT ANY WARRANTY; without even the implied warranty of
                     17: # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
                     18: # GNU General Public License for more details.
                     19: #
                     20: # You should have received a copy of the GNU General Public License
                     21: # along with LON-CAPA; if not, write to the Free Software
                     22: # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
                     23: #
                     24: # /home/httpd/html/adm/gpl.txt
                     25: #
                     26: # http://www.lon-capa.org/
                     27: #
1.25      harris41   28: ###
1.1       albertel   29: 
1.121     jms        30: =head1 NAME
                     31: 
                     32: Apache::lonacc - Cookie Based Access Handler
                     33: 
                     34: =head1 SYNOPSIS
                     35: 
                     36: Invoked (for various locations) by /etc/httpd/conf/srm.conf:
                     37: 
                     38:  PerlAccessHandler       Apache::lonacc
                     39: 
                     40: =head1 INTRODUCTION
                     41: 
                     42: This module enables cookie based authentication and is used
                     43: to control access for many different LON-CAPA URIs.
                     44: 
                     45: Whenever the client sends the cookie back to the server, 
                     46: this cookie is handled by either lonacc.pm or loncacc.pm
                     47: (see srm.conf for what is invoked when).  If
                     48: the cookie is missing or invalid, the user is re-challenged
                     49: for login information.
                     50: 
                     51: This is part of the LearningOnline Network with CAPA project
                     52: described at http://www.lon-capa.org.
                     53: 
                     54: =head1 HANDLER SUBROUTINE
                     55: 
                     56: This routine is called by Apache and mod_perl.
                     57: 
                     58: =over 4
                     59: 
                     60: =item *
                     61: 
                     62: transfer profile into environment
                     63: 
                     64: =item *
                     65: 
                     66: load POST parameters
                     67: 
                     68: =item *
                     69: 
                     70: check access
                     71: 
                     72: =item *
                     73: 
                     74: if allowed, get symb, log, generate course statistics if applicable
                     75: 
                     76: =item *
                     77: 
                     78: otherwise return error
                     79: 
                     80: =item *
                     81: 
                     82: see if public resource
                     83: 
                     84: =item *
                     85: 
                     86: store attempted access
                     87: 
                     88: =back
                     89: 
                     90: =head1 NOTABLE SUBROUTINES
                     91: 
                     92: =cut
                     93: 
1.119     jms        94: 
1.1       albertel   95: package Apache::lonacc;
                     96: 
                     97: use strict;
1.8       www        98: use Apache::Constants qw(:common :http :methods);
1.2       www        99: use Apache::File;
1.6       www       100: use Apache::lonnet;
1.25      harris41  101: use Apache::loncommon();
1.47      www       102: use Apache::lonlocal;
1.86      albertel  103: use Apache::restrictedaccess();
1.148     raeburn   104: use Apache::blockedaccess();
1.16      www       105: use Fcntl qw(:flock);
1.141     raeburn   106: use LONCAPA qw(:DEFAULT :match);
1.1       albertel  107: 
1.75      albertel  108: sub cleanup {
                    109:     my ($r)=@_;
                    110:     if (! $r->is_initial_req()) { return DECLINED; }
                    111:     &Apache::lonnet::save_cache();
                    112:     return OK;
                    113: }
                    114: 
                    115: sub goodbye {
                    116:     my ($r)=@_;
                    117:     &Apache::lonnet::goodbye();
                    118:     return DONE;
                    119: }
                    120: 
1.76      albertel  121: ###############################################
                    122: 
                    123: sub get_posted_cgi {
1.114     raeburn   124:     my ($r,$fields) = @_;
1.76      albertel  125: 
                    126:     my $buffer;
                    127:     if ($r->header_in('Content-length')) {
                    128: 	$r->read($buffer,$r->header_in('Content-length'),0);
                    129:     }
1.113     albertel  130:     my $content_type = $r->header_in('Content-type');
                    131:     if ($content_type !~ m{^multipart/form-data}) {
1.76      albertel  132: 	my @pairs=split(/&/,$buffer);
                    133: 	my $pair;
                    134: 	foreach $pair (@pairs) {
                    135: 	    my ($name,$value) = split(/=/,$pair);
                    136: 	    $value =~ tr/+/ /;
                    137: 	    $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
                    138: 	    $name  =~ tr/+/ /;
                    139: 	    $name  =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
1.114     raeburn   140:             if (ref($fields) eq 'ARRAY') {
                    141:                 next if (!grep(/^\Q$name\E$/,@{$fields}));
                    142:             }
1.77      albertel  143: 	    &Apache::loncommon::add_to_env("form.$name",$value);
1.76      albertel  144: 	}
                    145:     } else {
1.113     albertel  146: 	my ($contentsep) = ($content_type =~ /boundary=\"?([^\";,]+)\"?/);
1.76      albertel  147: 	my @lines = split (/\n/,$buffer);
                    148: 	my $name='';
                    149: 	my $value='';
                    150: 	my $fname='';
                    151: 	my $fmime='';
                    152: 	my $i;
                    153: 	for ($i=0;$i<=$#lines;$i++) {
1.113     albertel  154: 	    if ($lines[$i]=~/^--\Q$contentsep\E/) {
1.76      albertel  155: 		if ($name) {
1.139     raeburn   156:                     chomp($value);
                    157:                     if (($r->uri eq '/adm/portfolio') && 
                    158:                         ($name eq 'uploaddoc')) {
                    159:                         if (length($value) == 1) {
                    160:                             $value=~s/[\r\n]$//;
                    161:                         }
1.154     raeburn   162:                     } elsif ($fname =~ /\.(xls|doc|ppt)x$/i) {
                    163:                         $value=~s/[\r\n]$//;
1.139     raeburn   164:                     }
1.114     raeburn   165:                     if (ref($fields) eq 'ARRAY') {
                    166:                         next if (!grep(/^\Q$name\E$/,@{$fields}));
                    167:                     }
1.118     raeburn   168:                     if ($fname) {
                    169:                         if ($env{'form.symb'} ne '') {
                    170:                             my $size = (length($value))/(1024.0 * 1024.0);
                    171:                             if (&upload_size_allowed($name,$size,$fname) eq 'ok') {
                    172:                                 $env{"form.$name.filename"}=$fname;
                    173:                                 $env{"form.$name.mimetype"}=$fmime;
                    174:                                 &Apache::loncommon::add_to_env("form.$name",$value);
                    175:                             }
                    176:                         } else {
                    177:                             $env{"form.$name.filename"}=$fname;
                    178:                             $env{"form.$name.mimetype"}=$fmime;
                    179:                             &Apache::loncommon::add_to_env("form.$name",$value);
                    180:                         }
                    181:                     } else {
                    182:                         $value=~s/\s+$//s;
                    183:                         &Apache::loncommon::add_to_env("form.$name",$value);
                    184:                     }
1.76      albertel  185: 		}
                    186: 		if ($i<$#lines) {
                    187: 		    $i++;
                    188: 		    $lines[$i]=~
                    189: 		/Content\-Disposition\:\s*form\-data\;\s*name\=\"([^\"]+)\"/i;
                    190: 		    $name=$1;
                    191: 		    $value='';
                    192: 		    if ($lines[$i]=~/filename\=\"([^\"]+)\"/i) {
                    193: 			$fname=$1;
                    194: 			if 
                    195:                             ($lines[$i+1]=~/Content\-Type\:\s*([\w\-\/]+)/i) {
                    196: 				$fmime=$1;
                    197: 				$i++;
                    198: 			    } else {
                    199: 				$fmime='';
                    200: 			    }
                    201: 		    } else {
                    202: 			$fname='';
                    203: 			$fmime='';
                    204: 		    }
                    205: 		    $i++;
                    206: 		}
                    207: 	    } else {
                    208: 		$value.=$lines[$i]."\n";
                    209: 	    }
                    210: 	}
                    211:     }
                    212: #
                    213: # Digested POSTed values
                    214: #
                    215: # Remember the way this was originally done (GET or POST)
                    216: #
                    217:     $env{'request.method'}=$ENV{'REQUEST_METHOD'};
                    218: #
                    219: # There may also be stuff in the query string
                    220: # Tell subsequent handlers that this was GET, not POST, so they can access query string.
                    221: # Also, unset POSTed content length to cover all tracks.
                    222: #
                    223: 
                    224:     $r->method_number(M_GET);
                    225: 
                    226:     $r->method('GET');
                    227:     $r->headers_in->unset('Content-length');
                    228: }
                    229: 
1.121     jms       230: =pod
                    231: 
1.146     raeburn   232: =over
                    233: 
1.121     jms       234: =item upload_size_allowed()
                    235: 
                    236: 	Perform size checks for file uploads to essayresponse items in course context.
                    237: 	
                    238: 	Add form.HWFILESIZE.$part_$id to %env with file size (MB)
                    239: 	If file exceeds maximum allowed size, add form.HWFILETOOBIG.$part_$id to %env.
                    240: 
                    241: =cut
1.118     raeburn   242:  
                    243: sub upload_size_allowed {
                    244:     my ($name,$size,$fname) = @_;
                    245:     if ($name =~ /^HWFILE(\w+)$/) {
                    246:         my $ident = $1;
                    247:         my $item = 'HWFILESIZE'.$ident;
1.122     raeburn   248:         my $savesize = sprintf("%.6f",$size);
                    249:         &Apache::loncommon::add_to_env("form.$item",$savesize);
1.118     raeburn   250:         my $maxsize= &Apache::lonnet::EXT("resource.$ident.maxfilesize");
                    251:         if (!$maxsize) {
1.123     raeburn   252:             $maxsize = 10.0; # FIXME This should become a domain configuration.
1.118     raeburn   253:         }
                    254:         if ($size > $maxsize) {
                    255:             my $warn = 'HWFILETOOBIG'.$ident;
                    256:             &Apache::loncommon::add_to_env("form.$warn",$fname);
                    257:             return;
                    258:         }
                    259:     }
                    260:     return 'ok';
                    261: }
                    262: 
1.121     jms       263: =pod
                    264: 
                    265: =item sso_login()
                    266: 
                    267: 	handle the case of the single sign on user, at this point $r->user 
1.150     raeburn   268: 	will be set and valid; now need to find the loncapa user info, and possibly
1.149     raeburn   269: 	balance them. If $r->user() is set this means either it was either set by
1.150     raeburn   270:         SSO or by checkauthen.pm, if a valid cookie was found. The latter case can
                    271:         be identified by the third arg ($usename), except when lonacc is called in 
                    272:         an internal redirect to /adm/switchserver (e.g., load-balancing following
                    273:         successful authentication) -- no cookie set yet.  For that particular case
                    274:         simply skip the call to sso_login(). 
1.149     raeburn   275: 
                    276: 	returns OK if it was SSO and user was handled.
                    277:         returns undef if not SSO or no means to handle the user.
1.121     jms       278:         
                    279: =cut
1.117     jms       280: 
1.94      albertel  281: sub sso_login {
1.149     raeburn   282:     my ($r,$handle,$username) = @_;
1.94      albertel  283: 
                    284:     my $lonidsdir=$r->dir_config('lonIDsDir');
1.156     raeburn   285:     if (($r->user eq '') || ($username ne '') || ($r->user eq 'public:public') ||
1.143     raeburn   286:         (defined($env{'user.name'}) && (defined($env{'user.domain'}))
                    287: 	  && ($handle ne ''))) {
1.94      albertel  288: 	# not an SSO case or already logged in
                    289: 	return undef;
                    290:     }
                    291: 
1.159.2.1  raeburn   292:     my ($user) = ($r->user =~ m/^($match_username)$/);
                    293:     if ($user eq '') {
                    294:         return undef;
                    295:     }
1.97      albertel  296: 
1.126     raeburn   297:     my $query = $r->args;
                    298:     my %form;
                    299:     if ($query) {
1.145     raeburn   300:         my @items = ('role','symb','iptoken');
1.127     raeburn   301:         &Apache::loncommon::get_unprocessed_cgi($query,\@items);
                    302:         foreach my $item (@items) {
                    303:             if (defined($env{'form.'.$item})) {
                    304:                 $form{$item} = $env{'form.'.$item};
1.126     raeburn   305:             }
                    306:         }
                    307:     }
                    308: 
1.145     raeburn   309:     my %sessiondata;
                    310:     if ($form{'iptoken'}) {
                    311:         %sessiondata = &Apache::lonnet::tmpget($form{'iptoken'});
1.158     raeburn   312:         my $delete = &Apache::lonnet::tmpdel($form{'iptoken'});
                    313:         unless ($sessiondata{'sessionserver'}) {
                    314:             delete($form{'iptoken'});
                    315:         }
1.145     raeburn   316:     }
                    317: 
1.136     raeburn   318:     my $domain = $r->dir_config('lonSSOUserDomain');
                    319:     if ($domain eq '') {
                    320:         $domain = $r->dir_config('lonDefDomain');
                    321:     }
1.97      albertel  322:     my $home=&Apache::lonnet::homeserver($user,$domain);
1.94      albertel  323:     if ($home !~ /(con_lost|no_host|no_such_host)/) {
1.107     albertel  324: 	&Apache::lonnet::logthis(" SSO authorized user $user ");
1.145     raeburn   325:         my ($is_balancer,$otherserver,$hosthere);
                    326:         if ($form{'iptoken'}) {
1.158     raeburn   327:             if (($sessiondata{'domain'} eq $domain) &&
                    328:                 ($sessiondata{'username'} eq $user)) {
1.145     raeburn   329:                 $hosthere = 1;
                    330:             }
                    331:         }
                    332:         unless ($hosthere) {
                    333:             ($is_balancer,$otherserver) =
                    334:                 &Apache::lonnet::check_loadbalancing($user,$domain);
                    335:         }
                    336: 
1.137     raeburn   337: 	if ($is_balancer) {
1.136     raeburn   338: 	    # login but immediately go to switch server to find us a new 
1.94      albertel  339: 	    # machine
1.127     raeburn   340: 	    &Apache::lonauth::success($r,$user,$domain,$home,'noredirect');
1.105     raeburn   341:             $env{'request.sso.login'} = 1;
1.106     raeburn   342:             if (defined($r->dir_config("lonSSOReloginServer"))) {
                    343:                 $env{'request.sso.reloginserver'} =
                    344:                     $r->dir_config('lonSSOReloginServer');
                    345:             }
1.137     raeburn   346:             my $redirecturl = '/adm/switchserver';
                    347:             if ($otherserver ne '') {
                    348:                 $redirecturl .= '?otherserver='.$otherserver;
                    349:             }
                    350: 	    $r->internal_redirect($redirecturl);
1.101     albertel  351: 	    $r->set_handlers('PerlHandler'=> undef);
1.94      albertel  352: 	} else {
                    353: 	    # need to login them in, so generate the need data that
                    354: 	    # migrate expects to do login
1.159.2.4! raeburn   355:             my $ip = $r->get_remote_host();
1.147     raeburn   356: 	    my %info=('ip'        => $ip,
1.94      albertel  357: 		      'domain'    => $domain,
1.97      albertel  358: 		      'username'  => $user,
1.94      albertel  359: 		      'server'    => $r->dir_config('lonHostID'),
                    360: 		      'sso.login' => 1
                    361: 		      );
1.158     raeburn   362:             foreach my $item ('role','symb','iptoken') {
1.126     raeburn   363:                 if (exists($form{$item})) {
                    364:                     $info{$item} = $form{$item};
                    365:                 }
                    366:             }
1.151     raeburn   367:             unless ($info{'symb'}) {
1.152     raeburn   368:                 unless (($r->uri eq '/adm/roles') || ($r->uri eq '/adm/sso')) {
1.151     raeburn   369:                     $info{'origurl'} = $r->uri; 
                    370:                 }
                    371:             }
1.116     raeburn   372:             if ($r->dir_config("ssodirecturl") == 1) {
                    373:                 $info{'origurl'} = $r->uri;
                    374:             }
1.106     raeburn   375:             if (defined($r->dir_config("lonSSOReloginServer"))) {
                    376:                 $info{'sso.reloginserver'} = 
                    377:                     $r->dir_config('lonSSOReloginServer'); 
                    378:             }
1.94      albertel  379: 	    my $token = 
                    380: 		&Apache::lonnet::tmpput(\%info,
                    381: 					$r->dir_config('lonHostID'));
                    382: 	    $env{'form.token'} = $token;
                    383: 	    $r->internal_redirect('/adm/migrateuser');
1.101     albertel  384: 	    $r->set_handlers('PerlHandler'=> undef);
1.94      albertel  385: 	}
                    386: 	return OK;
1.155     raeburn   387:     } else {
1.107     albertel  388: 	&Apache::lonnet::logthis(" SSO authorized unknown user $user ");
1.115     raeburn   389:         my @cancreate;
                    390:         my %domconfig =
                    391:             &Apache::lonnet::get_dom('configuration',['usercreation'],$domain);
                    392:         if (ref($domconfig{'usercreation'}) eq 'HASH') {
                    393:             if (ref($domconfig{'usercreation'}{'cancreate'}) eq 'HASH') {
                    394:                 if (ref($domconfig{'usercreation'}{'cancreate'}{'selfcreate'}) eq 'ARRAY') {
                    395:                     @cancreate = @{$domconfig{'usercreation'}{'cancreate'}{'selfcreate'}};
                    396:                 } elsif (($domconfig{'usercreation'}{'cancreate'}{'selfcreate'} ne 'none') && 
                    397:                          ($domconfig{'usercreation'}{'cancreate'}{'selfcreate'} ne '')) {
                    398:                     @cancreate = ($domconfig{'usercreation'}{'cancreate'}{'selfcreate'});
                    399:                 }
                    400:             }
                    401:         }
1.155     raeburn   402:         if ((grep(/^sso$/,@cancreate)) || (defined($r->dir_config('lonSSOUserUnknownRedirect')))) {
                    403:             $r->subprocess_env->set('SSOUserUnknown' => $user);
                    404:             $r->subprocess_env->set('SSOUserDomain' => $domain);
                    405:             if (grep(/^sso$/,@cancreate)) {
                    406:                 $r->set_handlers('PerlHandler'=> [\&Apache::createaccount::handler]);
                    407:                 $r->handler('perl-script');
                    408:             } else {
                    409: 	        $r->internal_redirect($r->dir_config('lonSSOUserUnknownRedirect'));
                    410:                 $r->set_handlers('PerlHandler'=> undef);
                    411:             }
                    412: 	    return OK;
1.115     raeburn   413:         }
1.94      albertel  414:     }
                    415:     return undef;
                    416: }
                    417: 
1.1       albertel  418: sub handler {
                    419:     my $r = shift;
                    420:     my $requrl=$r->uri;
1.149     raeburn   421: 
                    422:     if ($requrl =~ m{^/res/adm/pages/[^/]+\.(gif|png)$}) {
1.108     raeburn   423:         return OK;
                    424:     }
1.70      albertel  425: 
1.149     raeburn   426:     if (&Apache::lonnet::is_domainimage($requrl)) {
1.124     raeburn   427:         return OK;
                    428:     }
                    429: 
1.149     raeburn   430:     my %user;
                    431:     my $handle = &Apache::lonnet::check_for_valid_session($r,undef,\%user);
1.93      albertel  432: 
1.150     raeburn   433:     unless (($requrl eq '/adm/switchserver') && (!$r->is_initial_req())) {
                    434:         my $result = &sso_login($r,$handle,$user{'name'});
                    435:         if (defined($result)) {
                    436: 	    return $result;
                    437:         }
1.70      albertel  438:     }
                    439: 
1.137     raeburn   440:     my ($is_balancer,$otherserver);
1.142     raeburn   441: 
1.92      albertel  442:     if ($handle eq '') {
1.159     raeburn   443:         unless ((($requrl eq '/adm/switchserver') && (!$r->is_initial_req())) ||
                    444:                 ($requrl =~ m{^/public/$match_domain/$match_courseid/syllabus}) ||
                    445:                 ($requrl =~ m{^/adm/help/}) ||
                    446:                 ($requrl =~ m{^/res/$match_domain/$match_username/})) {
1.149     raeburn   447: 	    $r->log_reason("Cookie not valid", $r->filename);
1.142     raeburn   448:         }
1.111     albertel  449:     } elsif ($handle ne '') {
1.6       www       450: 
1.46      www       451: # ------------------------------------------------------ Initialize Environment
1.111     albertel  452: 	my $lonidsdir=$r->dir_config('lonIDsDir');
1.92      albertel  453: 	&Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle);
1.47      www       454: 
                    455: # --------------------------------------------------------- Initialize Language
                    456: 
1.92      albertel  457: 	&Apache::lonlocal::get_language_handle($r);
                    458: 
                    459:     }
1.46      www       460: 
1.92      albertel  461: # -------------------------------------------------- Should be a valid user now
                    462:     if ($env{'user.name'} ne '' && $env{'user.domain'} ne '') {
1.46      www       463: # -------------------------------------------------------------- Resource State
1.6       www       464: 
1.141     raeburn   465:         my ($cdom,$cnum);
                    466:         if ($env{'request.course.id'}) {
                    467:             $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                    468:             $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                    469:         }
1.92      albertel  470: 	if ($requrl=~/^\/+(res|uploaded)\//) {
                    471: 	    $env{'request.state'} = "published";
                    472: 	} else {
                    473: 	    $env{'request.state'} = 'unknown';
                    474: 	}
                    475: 	$env{'request.filename'} = $r->filename;
                    476: 	$env{'request.noversionuri'} = &Apache::lonnet::deversion($requrl);
1.157     raeburn   477:         my ($suppext,$checkabsolute);
1.129     raeburn   478:         if ($requrl =~ m{^/adm/wrapper/ext/}) {
                    479:             my $query = $r->args;
                    480:             if ($query) {
                    481:                 my $preserved;
                    482:                 foreach my $pair (split(/&/,$query)) {
                    483:                     my ($name, $value) = split(/=/,$pair);
1.131     droeschl  484:                     unless ($name eq 'symb') {
1.129     raeburn   485:                         $preserved .= $pair.'&';
                    486:                     }
1.141     raeburn   487:                     if (($env{'request.course.id'}) && ($name eq 'folderpath')) {
                    488:                         if ($value =~ /^supplemental/) {
                    489:                             $suppext = 1;
                    490:                         }
                    491:                     }
1.129     raeburn   492:                 }
                    493:                 $preserved =~ s/\&$//;
                    494:                 if ($preserved) {
                    495:                     $env{'request.external.querystring'} = $preserved;
                    496:                 }
                    497:             }
1.157     raeburn   498:             if ($env{'request.course.id'}) {
                    499:                 $checkabsolute = 1;
                    500:             }
1.141     raeburn   501:         } elsif ($env{'request.course.id'} &&
                    502:                  (($requrl =~ m{^/adm/$match_domain/$match_username/aboutme$}) ||
                    503:                   ($requrl =~ m{^/public/$cdom/$cnum/syllabus$}))) {
                    504:             my $query = $r->args;
                    505:             if ($query) {
                    506:                 foreach my $pair (split(/&/,$query)) {
                    507:                     my ($name, $value) = split(/=/,$pair);
                    508:                     if ($name eq 'folderpath') {
                    509:                         if ($value =~ /^supplemental/) {
                    510:                             $suppext = 1;
                    511:                         }
                    512:                     }
                    513:                 }
                    514:             }
1.157     raeburn   515:             if ($requrl =~ m{^/public/$cdom/$cnum/syllabus$}) {
                    516:                 $checkabsolute = 1;
                    517:             }
                    518:         }
                    519:         if ($checkabsolute) {
                    520:             my $hostname = $r->hostname();
                    521:             my $lonhost = &Apache::lonnet::host_from_dns($hostname);
                    522:             if ($lonhost) {
                    523:                 my $actual = &Apache::lonnet::absolute_url($hostname);
                    524:                 my $expected = $Apache::lonnet::protocol{$lonhost}.'://'.$hostname;
                    525:                 unless ($actual eq $expected) {
                    526:                     $env{'request.use_absolute'} = $expected;
                    527:                 }
                    528:             }
1.129     raeburn   529:         }
1.6       www       530: # -------------------------------------------------------- Load POST parameters
                    531: 
1.92      albertel  532: 	&Apache::lonacc::get_posted_cgi($r);
1.6       www       533: 
1.137     raeburn   534: # ------------------------------------------------------ Check if load balancer 
                    535: 
1.138     raeburn   536:         my $checkexempt;
                    537:         if ($env{'user.loadbalexempt'} eq $r->dir_config('lonHostID')) {
                    538:             if ($env{'user.loadbalcheck.time'} + 600 > time) {
                    539:                 $checkexempt = 1;    
                    540:             }
                    541:         }
1.145     raeburn   542:         if ($env{'user.noloadbalance'} eq $r->dir_config('lonHostID')) {
                    543:             $checkexempt = 1;
                    544:         }
1.138     raeburn   545:         unless ($checkexempt) {
                    546:             ($is_balancer,$otherserver) =
                    547:                 &Apache::lonnet::check_loadbalancing($env{'user.name'},
                    548:                                                      $env{'user.domain'});
                    549:         }
1.137     raeburn   550:         if ($is_balancer) {
                    551:             $r->set_handlers('PerlResponseHandler'=>
                    552:                              [\&Apache::switchserver::handler]);
                    553:             if ($otherserver ne '') {
                    554:                 $env{'form.otherserver'} = $otherserver;
                    555:             }
1.152     raeburn   556:             unless (($env{'form.origurl'}) || ($r->uri eq '/adm/roles') ||
                    557:                     ($r->uri eq '/adm/switchserver') || ($r->uri eq '/adm/sso')) {
                    558:                 $env{'form.origurl'} = $r->uri;
                    559:             }
1.137     raeburn   560:         }
                    561: 
1.6       www       562: # ---------------------------------------------------------------- Check access
1.92      albertel  563: 	my $now = time;
1.95      albertel  564: 	if ($requrl !~ m{^/(?:adm|public|prtspool)/}
                    565: 	    || $requrl =~ /^\/adm\/.*\/(smppg|bulletinboard)(\?|$ )/x) {
1.92      albertel  566: 	    my $access=&Apache::lonnet::allowed('bre',$requrl);
1.159     raeburn   567:             if ($handle eq '') {
                    568:                 unless ($access eq 'F') {
                    569:                     if ($requrl =~ m{^/res/$match_domain/$match_username/}) {
                    570:                         $r->log_reason("Cookie not valid", $r->filename);
                    571:                     }
                    572:                 }
                    573:             }
1.92      albertel  574: 	    if ($access eq '1') {
                    575: 		$env{'user.error.msg'}="$requrl:bre:0:0:Choose Course";
                    576: 		return HTTP_NOT_ACCEPTABLE; 
                    577: 	    }
                    578: 	    if ($access eq 'A') {
                    579: 		&Apache::restrictedaccess::setup_handler($r);
                    580: 		return OK;
                    581: 	    }
1.103     raeburn   582:             if ($access eq 'B') {
                    583:                 &Apache::blockedaccess::setup_handler($r);
                    584:                 return OK;
                    585:             }
1.92      albertel  586: 	    if (($access ne '2') && ($access ne 'F')) {
1.130     raeburn   587:                 if ($requrl =~ m{^/res/}) {
                    588:                     $access = &Apache::lonnet::allowed('bro',$requrl);
                    589:                     if ($access ne 'F') {
1.132     raeburn   590:                         if ($requrl eq '/res/lib/templates/simpleproblem.problem/smpedit') {
                    591:                             $access = &Apache::lonnet::allowed('bre','/res/lib/templates/simpleproblem.problem');
                    592:                             if ($access ne 'F') {
                    593:                                 $env{'user.error.msg'}="$requrl:bre:1:1:Access Denied";
                    594:                                 return HTTP_NOT_ACCEPTABLE;
                    595:                             }
                    596:                         } else {
                    597:                             $env{'user.error.msg'}="$requrl:bre:1:1:Access Denied";
                    598:                             return HTTP_NOT_ACCEPTABLE;
                    599:                         }
1.130     raeburn   600:                     }
1.159.2.3  raeburn   601:                 } elsif (($handle =~ /^publicuser_\d+$/) && (&Apache::lonnet::is_portfolio_url($requrl))) {
                    602:                     my $clientip = $r->get_remote_host();
                    603:                     if (&Apache::lonnet::allowed('bre',$requrl,undef,undef,$clientip) ne 'F') {
                    604:                         $env{'user.error.msg'}="$requrl:bre:1:1:Access Denied";
                    605:                         return HTTP_NOT_ACCEPTABLE;
                    606:                     }
1.130     raeburn   607:                 } else {
                    608: 		    $env{'user.error.msg'}="$requrl:bre:1:1:Access Denied";
                    609: 		    return HTTP_NOT_ACCEPTABLE;
                    610:                 }
1.37      albertel  611: 	    }
1.92      albertel  612: 	}
                    613: 	if ($requrl =~ m|^/prtspool/|) {
                    614: 	    my $start='/prtspool/'.$env{'user.name'}.'_'.
                    615: 		$env{'user.domain'};
                    616: 	    if ($requrl !~ /^\Q$start\E/) {
                    617: 		$env{'user.error.msg'}="$requrl:bre:1:1:Access Denied";
                    618: 		return HTTP_NOT_ACCEPTABLE;
1.67      albertel  619: 	    }
1.92      albertel  620: 	}
1.109     banghart  621: 	if ($requrl =~ m|^/zipspool/|) {
1.110     banghart  622: 	    my $start='/zipspool/zipout/'.$env{'user.name'}.":".
1.109     banghart  623: 		$env{'user.domain'};
                    624: 	    if ($requrl !~ /^\Q$start\E/) {
                    625: 		$env{'user.error.msg'}="$requrl:bre:1:1:Access Denied";
                    626: 		return HTTP_NOT_ACCEPTABLE;
                    627: 	    }
                    628: 	}
1.92      albertel  629: 	if ($env{'user.name'} eq 'public' && 
                    630: 	    $env{'user.domain'} eq 'public' &&
                    631: 	    $requrl !~ m{^/+(res|public|uploaded)/} &&
                    632: 	    $requrl !~ m{^/adm/[^/]+/[^/]+/aboutme/portfolio$ }x &&
1.128     droeschl  633:         $requrl !~ m{^/adm/blockingstatus/.*$} &&
1.92      albertel  634: 	    $requrl !~ m{^/+adm/(help|logout|restrictedaccess|randomlabel\.png)}) {
                    635: 	    $env{'request.querystring'}=$r->args;
                    636: 	    $env{'request.firsturl'}=$requrl;
                    637: 	    return FORBIDDEN;
                    638: 	}
1.23      www       639: # ------------------------------------------------------------- This is allowed
1.92      albertel  640: 	if ($env{'request.course.id'}) {
1.24      www       641: 	    &Apache::lonnet::countacc($requrl);
1.92      albertel  642: 	    $requrl=~/\.(\w+)$/;
1.125     raeburn   643:             my $query=$r->args;
1.92      albertel  644: 	    if ((&Apache::loncommon::fileembstyle($1) eq 'ssi') ||
1.133     raeburn   645: 		($requrl=~/^\/adm\/.*\/(aboutme|smppg|bulletinboard)(\?|$ )/x) ||
1.92      albertel  646: 		($requrl=~/^\/adm\/wrapper\//) ||
                    647: 		($requrl=~m|^/adm/coursedocs/showdoc/|) ||
                    648: 		($requrl=~m|\.problem/smpedit$|) ||
1.133     raeburn   649: 		($requrl=~/^\/public\/.*\/syllabus$/) ||
1.134     raeburn   650:                 ($requrl=~/^\/adm\/(viewclasslist|navmaps)$/) ||
                    651:                 ($requrl=~/^\/adm\/.*\/aboutme\/portfolio(\?|$)/)) {
1.23      www       652: # ------------------------------------- This is serious stuff, get symb and log
1.92      albertel  653: 		my $symb;
                    654: 		if ($query) {
1.141     raeburn   655: 		    &Apache::loncommon::get_unprocessed_cgi($query,['symb','folderpath']);
1.92      albertel  656: 		}
                    657: 		if ($env{'form.symb'}) {
1.64      albertel  658: 		    $symb=&Apache::lonnet::symbclean($env{'form.symb'});
1.92      albertel  659: 		    if ($requrl =~ m|^/adm/wrapper/|
1.72      albertel  660: 			|| $requrl =~ m|^/adm/coursedocs/showdoc/|) {
1.92      albertel  661: 			my ($map,$mid,$murl)=&Apache::lonnet::decode_symb($symb);
                    662: 			&Apache::lonnet::symblist($map,$murl => [$murl,$mid],
1.63      albertel  663: 						  'last_known' =>[$murl,$mid]);
1.92      albertel  664: 		    } elsif ((&Apache::lonnet::symbverify($symb,$requrl)) ||
1.53      albertel  665: 			     (($requrl=~m|(.*)/smpedit$|) &&
1.134     raeburn   666: 			      &Apache::lonnet::symbverify($symb,$1)) ||
                    667:                              (($requrl=~m|(.*/aboutme)/portfolio$|) &&
                    668:                               &Apache::lonnet::symbverify($symb,$1))) {
1.92      albertel  669: 			my ($map,$mid,$murl)=&Apache::lonnet::decode_symb($symb);
                    670: 			&Apache::lonnet::symblist($map,$murl => [$murl,$mid],
                    671: 						  'last_known' =>[$murl,$mid]);
1.31      www       672: 		    } else {
                    673: 			$r->log_reason('Invalid symb for '.$requrl.': '.
1.92      albertel  674: 				       $symb);
                    675: 			$env{'user.error.msg'}=
                    676: 			    "$requrl:bre:1:1:Invalid Access";
                    677: 			return HTTP_NOT_ACCEPTABLE; 
                    678: 		    }
                    679: 		} else {
1.134     raeburn   680:                     if ($requrl=~m{^(/adm/.*/aboutme)/portfolio$}) {
                    681:                         $requrl = $1;
                    682:                     }
1.141     raeburn   683:                     unless ($suppext) {
                    684: 		        $symb=&Apache::lonnet::symbread($requrl);
                    685: 		        if (&Apache::lonnet::is_on_map($requrl) && $symb &&
                    686: 			    !&Apache::lonnet::symbverify($symb,$requrl)) {
                    687: 			    $r->log_reason('Invalid symb for '.$requrl.': '.$symb);
                    688: 			    $env{'user.error.msg'}=
                    689: 			        "$requrl:bre:1:1:Invalid Access";
                    690: 			    return HTTP_NOT_ACCEPTABLE; 
                    691: 		        }
                    692: 		        if ($symb) {
                    693: 			    my ($map,$mid,$murl)=
                    694: 			        &Apache::lonnet::decode_symb($symb);
                    695: 			    &Apache::lonnet::symblist($map,$murl =>[$murl,$mid],
                    696: 						      'last_known' =>[$murl,$mid]);
                    697: 		        }
1.61      albertel  698: 		    }
1.92      albertel  699: 		}
                    700: 		$env{'request.symb'}=$symb;
                    701: 		&Apache::lonnet::courseacclog($symb);
                    702: 	    } else {
1.23      www       703: # ------------------------------------------------------- This is other content
1.92      albertel  704: 		&Apache::lonnet::courseacclog($requrl);    
                    705: 	    }
1.140     raeburn   706:             if ($requrl =~ m{^/+uploaded/\Q$cdom\E/\Q$cnum\E/(docs|supplemental)/.+\.html?$}) {
1.125     raeburn   707:                 if (&Apache::lonnet::allowed('mdc',$env{'request.course.id'})) {
                    708:                     if ($query) {
                    709:                         &Apache::loncommon::get_unprocessed_cgi($query,['forceedit']);
                    710:                         if ($env{'form.forceedit'}) {
                    711:                             $env{'request.state'} = 'edit';
                    712:                         }
                    713:                     }
                    714:                 }
1.144     raeburn   715:             } elsif ($requrl =~ m{^/+uploaded/\Q$cdom\E/\Q$cnum\E/portfolio/syllabus/.+\.html?$}) {
                    716:                 if (&Apache::lonnet::allowed('mdc',$env{'request.course.id'})) {
                    717:                     if ($query) {
                    718:                         &Apache::loncommon::get_unprocessed_cgi($query,['forceedit','editmode']);
                    719:                         if (($env{'form.forceedit'}) || ($env{'form.editmode'})) {
                    720:                             $env{'request.state'} = 'edit';
                    721:                         }
                    722:                     }
                    723:                 }
1.125     raeburn   724:             }
1.88      albertel  725: 	}
1.92      albertel  726: 	return OK;
1.137     raeburn   727:     } else {
                    728:         my $defdom=$r->dir_config('lonDefDomain');
                    729:         ($is_balancer,$otherserver) =
                    730:             &Apache::lonnet::check_loadbalancing(undef,$defdom);
                    731:         if ($is_balancer) {
                    732:             $r->set_handlers('PerlResponseHandler'=>
                    733:                              [\&Apache::switchserver::handler]);
                    734:             if ($otherserver ne '') {
                    735:                 $env{'form.otherserver'} = $otherserver;
                    736:             }
                    737:         }
1.92      albertel  738:     }
1.21      www       739: # -------------------------------------------- See if this is a public resource
1.68      albertel  740:     if ($requrl=~m|^/+adm/+help/+|) {
1.89      albertel  741:  	return OK;
1.68      albertel  742:     }
1.90      albertel  743: # ------------------------------------ See if this is a viewable portfolio file
1.89      albertel  744:     if (&Apache::lonnet::is_portfolio_url($requrl)) {
1.159.2.3  raeburn   745:         my $clientip = $r->get_remote_host();
                    746: 	my $access=&Apache::lonnet::allowed('bre',$requrl,undef,undef,$clientip);
1.90      albertel  747: 	if ($access eq 'A') {
                    748: 	    &Apache::restrictedaccess::setup_handler($r);
                    749: 	    return OK;
                    750: 	}
                    751: 	if (($access ne '2') && ($access ne 'F')) {
                    752: 	    $env{'user.error.msg'}="$requrl:bre:1:1:Access Denied";
                    753: 	    return HTTP_NOT_ACCEPTABLE;
                    754: 	}
1.79      raeburn   755:     }
1.87      albertel  756: 
1.34      www       757: # -------------------------------------------------------------- Not authorized
                    758:     $requrl=~/\.(\w+)$/;
1.62      albertel  759: #    if ((&Apache::loncommon::fileembstyle($1) eq 'ssi') ||
                    760: #        ($requrl=~/^\/adm\/(roles|logout|email|menu|remote)/) ||
                    761: #        ($requrl=~m|^/prtspool/|)) {
1.34      www       762: # -------------------------- Store where they wanted to go and get login screen
1.64      albertel  763: 	$env{'request.querystring'}=$r->args;
                    764: 	$env{'request.firsturl'}=$requrl;
1.34      www       765:        return FORBIDDEN;
1.62      albertel  766: #   } else {
1.34      www       767: # --------------------------------------------------------------------- Goodbye
1.62      albertel  768: #       return HTTP_BAD_REQUEST;
                    769: #   }
1.1       albertel  770: }
                    771: 
                    772: 1;
                    773: __END__
1.120     jms       774: 
1.121     jms       775: =pod
1.120     jms       776: 
1.121     jms       777: =back
1.120     jms       778: 
1.121     jms       779: =cut
1.120     jms       780: 

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.