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

1.1       albertel    1: # The LearningOnline Network
                      2: # Cookie Based Access Handler
1.22      www         3: #
1.168   ! raeburn     4: # $Id: lonacc.pm,v 1.167 2017/05/08 22:47:01 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.168   ! raeburn   162:                     } elsif ($fname =~ /\.(xls|doc|ppt)(x|m)$/i) {
1.154     raeburn   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: 		    }
1.162     damieng   205:                     if ($i<$#lines && $lines[$i+1]=~/^Content\-Type\:\s*([\w\-\/]+)/i) {
                    206:                         # TODO: something with $1 !
                    207:                         $i++;
                    208:                     }
                    209:                     if ($i<$#lines && $lines[$i+1]=~/^Content\-transfer\-encoding\:\s*([\w\-\/]+)/i) {
                    210:                         # TODO: something with $1 !
                    211:                         $i++;
                    212:                     }
1.76      albertel  213: 		    $i++;
                    214: 		}
                    215: 	    } else {
                    216: 		$value.=$lines[$i]."\n";
                    217: 	    }
                    218: 	}
                    219:     }
                    220: #
                    221: # Digested POSTed values
                    222: #
                    223: # Remember the way this was originally done (GET or POST)
                    224: #
                    225:     $env{'request.method'}=$ENV{'REQUEST_METHOD'};
                    226: #
                    227: # There may also be stuff in the query string
                    228: # Tell subsequent handlers that this was GET, not POST, so they can access query string.
                    229: # Also, unset POSTed content length to cover all tracks.
                    230: #
                    231: 
                    232:     $r->method_number(M_GET);
                    233: 
                    234:     $r->method('GET');
                    235:     $r->headers_in->unset('Content-length');
                    236: }
                    237: 
1.121     jms       238: =pod
                    239: 
1.146     raeburn   240: =over
                    241: 
1.121     jms       242: =item upload_size_allowed()
                    243: 
                    244: 	Perform size checks for file uploads to essayresponse items in course context.
                    245: 	
                    246: 	Add form.HWFILESIZE.$part_$id to %env with file size (MB)
                    247: 	If file exceeds maximum allowed size, add form.HWFILETOOBIG.$part_$id to %env.
                    248: 
                    249: =cut
1.118     raeburn   250:  
                    251: sub upload_size_allowed {
                    252:     my ($name,$size,$fname) = @_;
                    253:     if ($name =~ /^HWFILE(\w+)$/) {
                    254:         my $ident = $1;
                    255:         my $item = 'HWFILESIZE'.$ident;
1.122     raeburn   256:         my $savesize = sprintf("%.6f",$size);
                    257:         &Apache::loncommon::add_to_env("form.$item",$savesize);
1.118     raeburn   258:         my $maxsize= &Apache::lonnet::EXT("resource.$ident.maxfilesize");
                    259:         if (!$maxsize) {
1.123     raeburn   260:             $maxsize = 10.0; # FIXME This should become a domain configuration.
1.118     raeburn   261:         }
                    262:         if ($size > $maxsize) {
                    263:             my $warn = 'HWFILETOOBIG'.$ident;
                    264:             &Apache::loncommon::add_to_env("form.$warn",$fname);
                    265:             return;
                    266:         }
                    267:     }
                    268:     return 'ok';
                    269: }
                    270: 
1.121     jms       271: =pod
                    272: 
                    273: =item sso_login()
                    274: 
                    275: 	handle the case of the single sign on user, at this point $r->user 
1.150     raeburn   276: 	will be set and valid; now need to find the loncapa user info, and possibly
1.149     raeburn   277: 	balance them. If $r->user() is set this means either it was either set by
1.150     raeburn   278:         SSO or by checkauthen.pm, if a valid cookie was found. The latter case can
                    279:         be identified by the third arg ($usename), except when lonacc is called in 
                    280:         an internal redirect to /adm/switchserver (e.g., load-balancing following
                    281:         successful authentication) -- no cookie set yet.  For that particular case
                    282:         simply skip the call to sso_login(). 
1.149     raeburn   283: 
                    284: 	returns OK if it was SSO and user was handled.
                    285:         returns undef if not SSO or no means to handle the user.
1.121     jms       286:         
                    287: =cut
1.117     jms       288: 
1.94      albertel  289: sub sso_login {
1.149     raeburn   290:     my ($r,$handle,$username) = @_;
1.94      albertel  291: 
                    292:     my $lonidsdir=$r->dir_config('lonIDsDir');
1.156     raeburn   293:     if (($r->user eq '') || ($username ne '') || ($r->user eq 'public:public') ||
1.143     raeburn   294:         (defined($env{'user.name'}) && (defined($env{'user.domain'}))
                    295: 	  && ($handle ne ''))) {
1.94      albertel  296: 	# not an SSO case or already logged in
                    297: 	return undef;
                    298:     }
                    299: 
1.161     raeburn   300:     my ($user) = ($r->user =~ m/^($match_username)$/);
                    301:     if ($user eq '') {
                    302:         return undef;
                    303:     }
1.97      albertel  304: 
1.126     raeburn   305:     my $query = $r->args;
                    306:     my %form;
                    307:     if ($query) {
1.145     raeburn   308:         my @items = ('role','symb','iptoken');
1.127     raeburn   309:         &Apache::loncommon::get_unprocessed_cgi($query,\@items);
                    310:         foreach my $item (@items) {
                    311:             if (defined($env{'form.'.$item})) {
                    312:                 $form{$item} = $env{'form.'.$item};
1.126     raeburn   313:             }
                    314:         }
                    315:     }
                    316: 
1.145     raeburn   317:     my %sessiondata;
                    318:     if ($form{'iptoken'}) {
                    319:         %sessiondata = &Apache::lonnet::tmpget($form{'iptoken'});
1.158     raeburn   320:         my $delete = &Apache::lonnet::tmpdel($form{'iptoken'});
                    321:         unless ($sessiondata{'sessionserver'}) {
                    322:             delete($form{'iptoken'});
                    323:         }
1.145     raeburn   324:     }
                    325: 
1.136     raeburn   326:     my $domain = $r->dir_config('lonSSOUserDomain');
                    327:     if ($domain eq '') {
                    328:         $domain = $r->dir_config('lonDefDomain');
                    329:     }
1.97      albertel  330:     my $home=&Apache::lonnet::homeserver($user,$domain);
1.94      albertel  331:     if ($home !~ /(con_lost|no_host|no_such_host)/) {
1.107     albertel  332: 	&Apache::lonnet::logthis(" SSO authorized user $user ");
1.145     raeburn   333:         my ($is_balancer,$otherserver,$hosthere);
                    334:         if ($form{'iptoken'}) {
1.158     raeburn   335:             if (($sessiondata{'domain'} eq $domain) &&
                    336:                 ($sessiondata{'username'} eq $user)) {
1.145     raeburn   337:                 $hosthere = 1;
                    338:             }
                    339:         }
                    340:         unless ($hosthere) {
                    341:             ($is_balancer,$otherserver) =
1.165     raeburn   342:                 &Apache::lonnet::check_loadbalancing($user,$domain,'login');
                    343:             if ($is_balancer) {
                    344:                 if ($otherserver eq '') {
                    345:                     my $lowest_load;
                    346:                     ($otherserver,undef,undef,undef,$lowest_load) = &Apache::lonnet::choose_server($domain);
                    347:                     if ($lowest_load > 100) {
                    348:                         $otherserver = &Apache::lonnet::spareserver($lowest_load,$lowest_load,1,$domain);
                    349:                     }
                    350:                 }
                    351:                 if ($otherserver ne '') {
                    352:                     my @hosts = &Apache::lonnet::current_machine_ids();
                    353:                     if (grep(/^\Q$otherserver\E$/,@hosts)) {
                    354:                         $hosthere = $otherserver;
                    355:                     }
                    356:                 }
                    357:             }
1.145     raeburn   358:         }
1.165     raeburn   359: 	if (($is_balancer) && (!$hosthere)) {
1.136     raeburn   360: 	    # login but immediately go to switch server to find us a new 
1.94      albertel  361: 	    # machine
1.127     raeburn   362: 	    &Apache::lonauth::success($r,$user,$domain,$home,'noredirect');
1.105     raeburn   363:             $env{'request.sso.login'} = 1;
1.106     raeburn   364:             if (defined($r->dir_config("lonSSOReloginServer"))) {
                    365:                 $env{'request.sso.reloginserver'} =
                    366:                     $r->dir_config('lonSSOReloginServer');
                    367:             }
1.137     raeburn   368:             my $redirecturl = '/adm/switchserver';
                    369:             if ($otherserver ne '') {
                    370:                 $redirecturl .= '?otherserver='.$otherserver;
                    371:             }
                    372: 	    $r->internal_redirect($redirecturl);
1.101     albertel  373: 	    $r->set_handlers('PerlHandler'=> undef);
1.94      albertel  374: 	} else {
                    375: 	    # need to login them in, so generate the need data that
                    376: 	    # migrate expects to do login
1.164     raeburn   377: 	    my $ip = $r->get_remote_host();
1.147     raeburn   378: 	    my %info=('ip'        => $ip,
1.94      albertel  379: 		      'domain'    => $domain,
1.97      albertel  380: 		      'username'  => $user,
1.94      albertel  381: 		      'server'    => $r->dir_config('lonHostID'),
                    382: 		      'sso.login' => 1
                    383: 		      );
1.158     raeburn   384:             foreach my $item ('role','symb','iptoken') {
1.126     raeburn   385:                 if (exists($form{$item})) {
                    386:                     $info{$item} = $form{$item};
                    387:                 }
                    388:             }
1.151     raeburn   389:             unless ($info{'symb'}) {
1.152     raeburn   390:                 unless (($r->uri eq '/adm/roles') || ($r->uri eq '/adm/sso')) {
1.151     raeburn   391:                     $info{'origurl'} = $r->uri; 
                    392:                 }
                    393:             }
1.116     raeburn   394:             if ($r->dir_config("ssodirecturl") == 1) {
                    395:                 $info{'origurl'} = $r->uri;
                    396:             }
1.106     raeburn   397:             if (defined($r->dir_config("lonSSOReloginServer"))) {
                    398:                 $info{'sso.reloginserver'} = 
                    399:                     $r->dir_config('lonSSOReloginServer'); 
                    400:             }
1.165     raeburn   401:             if (($is_balancer) && ($hosthere)) {
                    402:                 $info{'noloadbalance'} = $hosthere;
                    403:             }
1.94      albertel  404: 	    my $token = 
                    405: 		&Apache::lonnet::tmpput(\%info,
                    406: 					$r->dir_config('lonHostID'));
                    407: 	    $env{'form.token'} = $token;
                    408: 	    $r->internal_redirect('/adm/migrateuser');
1.101     albertel  409: 	    $r->set_handlers('PerlHandler'=> undef);
1.94      albertel  410: 	}
                    411: 	return OK;
1.155     raeburn   412:     } else {
1.107     albertel  413: 	&Apache::lonnet::logthis(" SSO authorized unknown user $user ");
1.115     raeburn   414:         my @cancreate;
                    415:         my %domconfig =
                    416:             &Apache::lonnet::get_dom('configuration',['usercreation'],$domain);
                    417:         if (ref($domconfig{'usercreation'}) eq 'HASH') {
                    418:             if (ref($domconfig{'usercreation'}{'cancreate'}) eq 'HASH') {
                    419:                 if (ref($domconfig{'usercreation'}{'cancreate'}{'selfcreate'}) eq 'ARRAY') {
                    420:                     @cancreate = @{$domconfig{'usercreation'}{'cancreate'}{'selfcreate'}};
                    421:                 } elsif (($domconfig{'usercreation'}{'cancreate'}{'selfcreate'} ne 'none') && 
                    422:                          ($domconfig{'usercreation'}{'cancreate'}{'selfcreate'} ne '')) {
                    423:                     @cancreate = ($domconfig{'usercreation'}{'cancreate'}{'selfcreate'});
                    424:                 }
                    425:             }
                    426:         }
1.155     raeburn   427:         if ((grep(/^sso$/,@cancreate)) || (defined($r->dir_config('lonSSOUserUnknownRedirect')))) {
                    428:             $r->subprocess_env->set('SSOUserUnknown' => $user);
                    429:             $r->subprocess_env->set('SSOUserDomain' => $domain);
                    430:             if (grep(/^sso$/,@cancreate)) {
                    431:                 $r->set_handlers('PerlHandler'=> [\&Apache::createaccount::handler]);
                    432:                 $r->handler('perl-script');
                    433:             } else {
                    434: 	        $r->internal_redirect($r->dir_config('lonSSOUserUnknownRedirect'));
                    435:                 $r->set_handlers('PerlHandler'=> undef);
                    436:             }
                    437: 	    return OK;
1.115     raeburn   438:         }
1.94      albertel  439:     }
                    440:     return undef;
                    441: }
                    442: 
1.1       albertel  443: sub handler {
                    444:     my $r = shift;
                    445:     my $requrl=$r->uri;
1.149     raeburn   446: 
                    447:     if ($requrl =~ m{^/res/adm/pages/[^/]+\.(gif|png)$}) {
1.108     raeburn   448:         return OK;
                    449:     }
1.70      albertel  450: 
1.149     raeburn   451:     if (&Apache::lonnet::is_domainimage($requrl)) {
1.124     raeburn   452:         return OK;
                    453:     }
                    454: 
1.149     raeburn   455:     my %user;
                    456:     my $handle = &Apache::lonnet::check_for_valid_session($r,undef,\%user);
1.93      albertel  457: 
1.150     raeburn   458:     unless (($requrl eq '/adm/switchserver') && (!$r->is_initial_req())) {
                    459:         my $result = &sso_login($r,$handle,$user{'name'});
                    460:         if (defined($result)) {
                    461: 	    return $result;
                    462:         }
1.70      albertel  463:     }
                    464: 
1.137     raeburn   465:     my ($is_balancer,$otherserver);
1.142     raeburn   466: 
1.92      albertel  467:     if ($handle eq '') {
1.159     raeburn   468:         unless ((($requrl eq '/adm/switchserver') && (!$r->is_initial_req())) ||
                    469:                 ($requrl =~ m{^/public/$match_domain/$match_courseid/syllabus}) ||
                    470:                 ($requrl =~ m{^/adm/help/}) ||
                    471:                 ($requrl =~ m{^/res/$match_domain/$match_username/})) {
1.149     raeburn   472: 	    $r->log_reason("Cookie not valid", $r->filename);
1.142     raeburn   473:         }
1.111     albertel  474:     } elsif ($handle ne '') {
1.6       www       475: 
1.46      www       476: # ------------------------------------------------------ Initialize Environment
1.111     albertel  477: 	my $lonidsdir=$r->dir_config('lonIDsDir');
1.92      albertel  478: 	&Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle);
1.47      www       479: 
                    480: # --------------------------------------------------------- Initialize Language
                    481: 
1.92      albertel  482: 	&Apache::lonlocal::get_language_handle($r);
                    483: 
                    484:     }
1.46      www       485: 
1.92      albertel  486: # -------------------------------------------------- Should be a valid user now
                    487:     if ($env{'user.name'} ne '' && $env{'user.domain'} ne '') {
1.46      www       488: # -------------------------------------------------------------- Resource State
1.6       www       489: 
1.141     raeburn   490:         my ($cdom,$cnum);
                    491:         if ($env{'request.course.id'}) {
                    492:             $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                    493:             $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
                    494:         }
1.92      albertel  495: 	if ($requrl=~/^\/+(res|uploaded)\//) {
                    496: 	    $env{'request.state'} = "published";
                    497: 	} else {
                    498: 	    $env{'request.state'} = 'unknown';
                    499: 	}
                    500: 	$env{'request.filename'} = $r->filename;
                    501: 	$env{'request.noversionuri'} = &Apache::lonnet::deversion($requrl);
1.157     raeburn   502:         my ($suppext,$checkabsolute);
1.129     raeburn   503:         if ($requrl =~ m{^/adm/wrapper/ext/}) {
                    504:             my $query = $r->args;
                    505:             if ($query) {
                    506:                 my $preserved;
                    507:                 foreach my $pair (split(/&/,$query)) {
                    508:                     my ($name, $value) = split(/=/,$pair);
1.131     droeschl  509:                     unless ($name eq 'symb') {
1.129     raeburn   510:                         $preserved .= $pair.'&';
                    511:                     }
1.141     raeburn   512:                     if (($env{'request.course.id'}) && ($name eq 'folderpath')) {
                    513:                         if ($value =~ /^supplemental/) {
                    514:                             $suppext = 1;
                    515:                         }
                    516:                     }
1.129     raeburn   517:                 }
                    518:                 $preserved =~ s/\&$//;
                    519:                 if ($preserved) {
                    520:                     $env{'request.external.querystring'} = $preserved;
                    521:                 }
                    522:             }
1.157     raeburn   523:             if ($env{'request.course.id'}) {
                    524:                 $checkabsolute = 1;
                    525:             }
1.141     raeburn   526:         } elsif ($env{'request.course.id'} &&
                    527:                  (($requrl =~ m{^/adm/$match_domain/$match_username/aboutme$}) ||
1.166     raeburn   528:                   ($requrl eq "/public/$cdom/$cnum/syllabus") ||
1.167     raeburn   529:                   ($requrl =~ m{^/adm/$cdom/$cnum/\d+/ext\.tool$}))) {
1.141     raeburn   530:             my $query = $r->args;
                    531:             if ($query) {
                    532:                 foreach my $pair (split(/&/,$query)) {
                    533:                     my ($name, $value) = split(/=/,$pair);
                    534:                     if ($name eq 'folderpath') {
                    535:                         if ($value =~ /^supplemental/) {
                    536:                             $suppext = 1;
                    537:                         }
                    538:                     }
                    539:                 }
                    540:             }
1.157     raeburn   541:             if ($requrl =~ m{^/public/$cdom/$cnum/syllabus$}) {
                    542:                 $checkabsolute = 1;
                    543:             }
                    544:         }
                    545:         if ($checkabsolute) {
                    546:             my $hostname = $r->hostname();
                    547:             my $lonhost = &Apache::lonnet::host_from_dns($hostname);
                    548:             if ($lonhost) {
                    549:                 my $actual = &Apache::lonnet::absolute_url($hostname);
                    550:                 my $expected = $Apache::lonnet::protocol{$lonhost}.'://'.$hostname;
                    551:                 unless ($actual eq $expected) {
                    552:                     $env{'request.use_absolute'} = $expected;
                    553:                 }
                    554:             }
1.129     raeburn   555:         }
1.6       www       556: # -------------------------------------------------------- Load POST parameters
                    557: 
1.92      albertel  558: 	&Apache::lonacc::get_posted_cgi($r);
1.6       www       559: 
1.137     raeburn   560: # ------------------------------------------------------ Check if load balancer 
                    561: 
1.138     raeburn   562:         my $checkexempt;
                    563:         if ($env{'user.loadbalexempt'} eq $r->dir_config('lonHostID')) {
                    564:             if ($env{'user.loadbalcheck.time'} + 600 > time) {
                    565:                 $checkexempt = 1;    
                    566:             }
                    567:         }
1.145     raeburn   568:         if ($env{'user.noloadbalance'} eq $r->dir_config('lonHostID')) {
                    569:             $checkexempt = 1;
                    570:         }
1.138     raeburn   571:         unless ($checkexempt) {
                    572:             ($is_balancer,$otherserver) =
                    573:                 &Apache::lonnet::check_loadbalancing($env{'user.name'},
                    574:                                                      $env{'user.domain'});
                    575:         }
1.137     raeburn   576:         if ($is_balancer) {
                    577:             $r->set_handlers('PerlResponseHandler'=>
                    578:                              [\&Apache::switchserver::handler]);
                    579:             if ($otherserver ne '') {
                    580:                 $env{'form.otherserver'} = $otherserver;
                    581:             }
1.152     raeburn   582:             unless (($env{'form.origurl'}) || ($r->uri eq '/adm/roles') ||
                    583:                     ($r->uri eq '/adm/switchserver') || ($r->uri eq '/adm/sso')) {
                    584:                 $env{'form.origurl'} = $r->uri;
                    585:             }
1.137     raeburn   586:         }
                    587: 
1.6       www       588: # ---------------------------------------------------------------- Check access
1.92      albertel  589: 	my $now = time;
1.95      albertel  590: 	if ($requrl !~ m{^/(?:adm|public|prtspool)/}
                    591: 	    || $requrl =~ /^\/adm\/.*\/(smppg|bulletinboard)(\?|$ )/x) {
1.92      albertel  592: 	    my $access=&Apache::lonnet::allowed('bre',$requrl);
1.159     raeburn   593:             if ($handle eq '') {
                    594:                 unless ($access eq 'F') {
                    595:                     if ($requrl =~ m{^/res/$match_domain/$match_username/}) {
                    596:                         $r->log_reason("Cookie not valid", $r->filename);
                    597:                     }
                    598:                 }
                    599:             }
1.92      albertel  600: 	    if ($access eq '1') {
                    601: 		$env{'user.error.msg'}="$requrl:bre:0:0:Choose Course";
                    602: 		return HTTP_NOT_ACCEPTABLE; 
                    603: 	    }
                    604: 	    if ($access eq 'A') {
                    605: 		&Apache::restrictedaccess::setup_handler($r);
                    606: 		return OK;
                    607: 	    }
1.103     raeburn   608:             if ($access eq 'B') {
                    609:                 &Apache::blockedaccess::setup_handler($r);
                    610:                 return OK;
                    611:             }
1.92      albertel  612: 	    if (($access ne '2') && ($access ne 'F')) {
1.130     raeburn   613:                 if ($requrl =~ m{^/res/}) {
                    614:                     $access = &Apache::lonnet::allowed('bro',$requrl);
                    615:                     if ($access ne 'F') {
1.132     raeburn   616:                         if ($requrl eq '/res/lib/templates/simpleproblem.problem/smpedit') {
                    617:                             $access = &Apache::lonnet::allowed('bre','/res/lib/templates/simpleproblem.problem');
                    618:                             if ($access ne 'F') {
                    619:                                 $env{'user.error.msg'}="$requrl:bre:1:1:Access Denied";
                    620:                                 return HTTP_NOT_ACCEPTABLE;
                    621:                             }
                    622:                         } else {
                    623:                             $env{'user.error.msg'}="$requrl:bre:1:1:Access Denied";
                    624:                             return HTTP_NOT_ACCEPTABLE;
                    625:                         }
1.130     raeburn   626:                     }
1.160     raeburn   627:                 } elsif (($handle =~ /^publicuser_\d+$/) && (&Apache::lonnet::is_portfolio_url($requrl))) {
                    628:                     my $clientip = $r->get_remote_host();
                    629:                     if (&Apache::lonnet::allowed('bre',$requrl,undef,undef,$clientip) ne 'F') {
                    630:                         $env{'user.error.msg'}="$requrl:bre:1:1:Access Denied";
                    631:                         return HTTP_NOT_ACCEPTABLE;
                    632:                     }
1.130     raeburn   633:                 } else {
                    634: 		    $env{'user.error.msg'}="$requrl:bre:1:1:Access Denied";
                    635: 		    return HTTP_NOT_ACCEPTABLE;
                    636:                 }
1.37      albertel  637: 	    }
1.92      albertel  638: 	}
                    639: 	if ($requrl =~ m|^/prtspool/|) {
                    640: 	    my $start='/prtspool/'.$env{'user.name'}.'_'.
                    641: 		$env{'user.domain'};
                    642: 	    if ($requrl !~ /^\Q$start\E/) {
                    643: 		$env{'user.error.msg'}="$requrl:bre:1:1:Access Denied";
                    644: 		return HTTP_NOT_ACCEPTABLE;
1.67      albertel  645: 	    }
1.92      albertel  646: 	}
1.109     banghart  647: 	if ($requrl =~ m|^/zipspool/|) {
1.110     banghart  648: 	    my $start='/zipspool/zipout/'.$env{'user.name'}.":".
1.109     banghart  649: 		$env{'user.domain'};
                    650: 	    if ($requrl !~ /^\Q$start\E/) {
                    651: 		$env{'user.error.msg'}="$requrl:bre:1:1:Access Denied";
                    652: 		return HTTP_NOT_ACCEPTABLE;
                    653: 	    }
                    654: 	}
1.92      albertel  655: 	if ($env{'user.name'} eq 'public' && 
                    656: 	    $env{'user.domain'} eq 'public' &&
                    657: 	    $requrl !~ m{^/+(res|public|uploaded)/} &&
                    658: 	    $requrl !~ m{^/adm/[^/]+/[^/]+/aboutme/portfolio$ }x &&
1.128     droeschl  659:         $requrl !~ m{^/adm/blockingstatus/.*$} &&
1.92      albertel  660: 	    $requrl !~ m{^/+adm/(help|logout|restrictedaccess|randomlabel\.png)}) {
                    661: 	    $env{'request.querystring'}=$r->args;
                    662: 	    $env{'request.firsturl'}=$requrl;
                    663: 	    return FORBIDDEN;
                    664: 	}
1.23      www       665: # ------------------------------------------------------------- This is allowed
1.92      albertel  666: 	if ($env{'request.course.id'}) {
1.24      www       667: 	    &Apache::lonnet::countacc($requrl);
1.92      albertel  668: 	    $requrl=~/\.(\w+)$/;
1.125     raeburn   669:             my $query=$r->args;
1.92      albertel  670: 	    if ((&Apache::loncommon::fileembstyle($1) eq 'ssi') ||
1.133     raeburn   671: 		($requrl=~/^\/adm\/.*\/(aboutme|smppg|bulletinboard)(\?|$ )/x) ||
1.92      albertel  672: 		($requrl=~/^\/adm\/wrapper\//) ||
                    673: 		($requrl=~m|^/adm/coursedocs/showdoc/|) ||
                    674: 		($requrl=~m|\.problem/smpedit$|) ||
1.133     raeburn   675: 		($requrl=~/^\/public\/.*\/syllabus$/) ||
1.134     raeburn   676:                 ($requrl=~/^\/adm\/(viewclasslist|navmaps)$/) ||
1.166     raeburn   677:                 ($requrl=~/^\/adm\/.*\/aboutme\/portfolio(\?|$)/) ||
1.167     raeburn   678:                 ($requrl=~m{^/adm/$cdom/$cnum/\d+/ext\.tool$})) {
1.23      www       679: # ------------------------------------- This is serious stuff, get symb and log
1.92      albertel  680: 		my $symb;
                    681: 		if ($query) {
1.141     raeburn   682: 		    &Apache::loncommon::get_unprocessed_cgi($query,['symb','folderpath']);
1.92      albertel  683: 		}
                    684: 		if ($env{'form.symb'}) {
1.64      albertel  685: 		    $symb=&Apache::lonnet::symbclean($env{'form.symb'});
1.92      albertel  686: 		    if ($requrl =~ m|^/adm/wrapper/|
1.72      albertel  687: 			|| $requrl =~ m|^/adm/coursedocs/showdoc/|) {
1.92      albertel  688: 			my ($map,$mid,$murl)=&Apache::lonnet::decode_symb($symb);
                    689: 			&Apache::lonnet::symblist($map,$murl => [$murl,$mid],
1.63      albertel  690: 						  'last_known' =>[$murl,$mid]);
1.92      albertel  691: 		    } elsif ((&Apache::lonnet::symbverify($symb,$requrl)) ||
1.53      albertel  692: 			     (($requrl=~m|(.*)/smpedit$|) &&
1.134     raeburn   693: 			      &Apache::lonnet::symbverify($symb,$1)) ||
                    694:                              (($requrl=~m|(.*/aboutme)/portfolio$|) &&
                    695:                               &Apache::lonnet::symbverify($symb,$1))) {
1.92      albertel  696: 			my ($map,$mid,$murl)=&Apache::lonnet::decode_symb($symb);
                    697: 			&Apache::lonnet::symblist($map,$murl => [$murl,$mid],
                    698: 						  'last_known' =>[$murl,$mid]);
1.31      www       699: 		    } else {
                    700: 			$r->log_reason('Invalid symb for '.$requrl.': '.
1.92      albertel  701: 				       $symb);
                    702: 			$env{'user.error.msg'}=
                    703: 			    "$requrl:bre:1:1:Invalid Access";
                    704: 			return HTTP_NOT_ACCEPTABLE; 
                    705: 		    }
                    706: 		} else {
1.134     raeburn   707:                     if ($requrl=~m{^(/adm/.*/aboutme)/portfolio$}) {
                    708:                         $requrl = $1;
                    709:                     }
1.141     raeburn   710:                     unless ($suppext) {
                    711: 		        $symb=&Apache::lonnet::symbread($requrl);
                    712: 		        if (&Apache::lonnet::is_on_map($requrl) && $symb &&
                    713: 			    !&Apache::lonnet::symbverify($symb,$requrl)) {
                    714: 			    $r->log_reason('Invalid symb for '.$requrl.': '.$symb);
                    715: 			    $env{'user.error.msg'}=
                    716: 			        "$requrl:bre:1:1:Invalid Access";
                    717: 			    return HTTP_NOT_ACCEPTABLE; 
                    718: 		        }
                    719: 		        if ($symb) {
                    720: 			    my ($map,$mid,$murl)=
                    721: 			        &Apache::lonnet::decode_symb($symb);
                    722: 			    &Apache::lonnet::symblist($map,$murl =>[$murl,$mid],
                    723: 						      'last_known' =>[$murl,$mid]);
                    724: 		        }
1.61      albertel  725: 		    }
1.92      albertel  726: 		}
                    727: 		$env{'request.symb'}=$symb;
                    728: 		&Apache::lonnet::courseacclog($symb);
                    729: 	    } else {
1.23      www       730: # ------------------------------------------------------- This is other content
1.92      albertel  731: 		&Apache::lonnet::courseacclog($requrl);    
                    732: 	    }
1.140     raeburn   733:             if ($requrl =~ m{^/+uploaded/\Q$cdom\E/\Q$cnum\E/(docs|supplemental)/.+\.html?$}) {
1.125     raeburn   734:                 if (&Apache::lonnet::allowed('mdc',$env{'request.course.id'})) {
                    735:                     if ($query) {
                    736:                         &Apache::loncommon::get_unprocessed_cgi($query,['forceedit']);
                    737:                         if ($env{'form.forceedit'}) {
                    738:                             $env{'request.state'} = 'edit';
                    739:                         }
                    740:                     }
                    741:                 }
1.144     raeburn   742:             } elsif ($requrl =~ m{^/+uploaded/\Q$cdom\E/\Q$cnum\E/portfolio/syllabus/.+\.html?$}) {
                    743:                 if (&Apache::lonnet::allowed('mdc',$env{'request.course.id'})) {
                    744:                     if ($query) {
                    745:                         &Apache::loncommon::get_unprocessed_cgi($query,['forceedit','editmode']);
                    746:                         if (($env{'form.forceedit'}) || ($env{'form.editmode'})) {
                    747:                             $env{'request.state'} = 'edit';
                    748:                         }
                    749:                     }
                    750:                 }
1.125     raeburn   751:             }
1.88      albertel  752: 	}
1.92      albertel  753: 	return OK;
1.137     raeburn   754:     } else {
                    755:         my $defdom=$r->dir_config('lonDefDomain');
                    756:         ($is_balancer,$otherserver) =
                    757:             &Apache::lonnet::check_loadbalancing(undef,$defdom);
                    758:         if ($is_balancer) {
                    759:             $r->set_handlers('PerlResponseHandler'=>
                    760:                              [\&Apache::switchserver::handler]);
                    761:             if ($otherserver ne '') {
                    762:                 $env{'form.otherserver'} = $otherserver;
                    763:             }
                    764:         }
1.92      albertel  765:     }
1.21      www       766: # -------------------------------------------- See if this is a public resource
1.68      albertel  767:     if ($requrl=~m|^/+adm/+help/+|) {
1.89      albertel  768:  	return OK;
1.68      albertel  769:     }
1.90      albertel  770: # ------------------------------------ See if this is a viewable portfolio file
1.89      albertel  771:     if (&Apache::lonnet::is_portfolio_url($requrl)) {
1.160     raeburn   772:         my $clientip = $r->get_remote_host();
                    773:         my $access=&Apache::lonnet::allowed('bre',$requrl,undef,undef,$clientip);
1.90      albertel  774: 	if ($access eq 'A') {
                    775: 	    &Apache::restrictedaccess::setup_handler($r);
                    776: 	    return OK;
                    777: 	}
                    778: 	if (($access ne '2') && ($access ne 'F')) {
                    779: 	    $env{'user.error.msg'}="$requrl:bre:1:1:Access Denied";
                    780: 	    return HTTP_NOT_ACCEPTABLE;
                    781: 	}
1.79      raeburn   782:     }
1.87      albertel  783: 
1.34      www       784: # -------------------------------------------------------------- Not authorized
                    785:     $requrl=~/\.(\w+)$/;
1.62      albertel  786: #    if ((&Apache::loncommon::fileembstyle($1) eq 'ssi') ||
                    787: #        ($requrl=~/^\/adm\/(roles|logout|email|menu|remote)/) ||
                    788: #        ($requrl=~m|^/prtspool/|)) {
1.34      www       789: # -------------------------- Store where they wanted to go and get login screen
1.64      albertel  790: 	$env{'request.querystring'}=$r->args;
                    791: 	$env{'request.firsturl'}=$requrl;
1.34      www       792:        return FORBIDDEN;
1.62      albertel  793: #   } else {
1.34      www       794: # --------------------------------------------------------------------- Goodbye
1.62      albertel  795: #       return HTTP_BAD_REQUEST;
                    796: #   }
1.1       albertel  797: }
                    798: 
                    799: 1;
                    800: __END__
1.120     jms       801: 
1.121     jms       802: =pod
1.120     jms       803: 
1.121     jms       804: =back
1.120     jms       805: 
1.121     jms       806: =cut
1.120     jms       807: 

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.