loncom/auth/lonacc.pm - view

File: [LON-CAPA] / loncom / auth / lonacc.pm
Revision 1.143: download - view: text, annotated - select for diffs
Tue Feb 5 21:32:45 2013 UTC (11 years, 3 months ago) by raeburn
Branches: MAIN
CVS tags: HEAD

- Apache 2.4 requires $r->user() to be set, if "Require valid-user" applies to
  the requested page, otherwise there is an error:
  "No authentication done but request not allowed without authentication".

1: # The LearningOnline Network 2: # Cookie Based Access Handler 3: # 4: # $Id: lonacc.pm,v 1.143 2013/02/05 21:32:45 raeburn Exp $ 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: # 28: ### 29: 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: =over 93: 94: =cut 95: 96: 97: package Apache::lonacc; 98: 99: use strict; 100: use Apache::Constants qw(:common :http :methods); 101: use Apache::File; 102: use Apache::lonnet; 103: use Apache::loncommon(); 104: use Apache::lonlocal; 105: use Apache::restrictedaccess(); 106: use Apache::blockedaccess(); 107: use Fcntl qw(:flock); 108: use LONCAPA qw(:DEFAULT :match); 109: 110: sub cleanup { 111: my ($r)=@_; 112: if (! $r->is_initial_req()) { return DECLINED; } 113: &Apache::lonnet::save_cache(); 114: &Apache::lontexconvert::jsMath_reset(); 115: return OK; 116: } 117: 118: sub goodbye { 119: my ($r)=@_; 120: &Apache::lonnet::goodbye(); 121: return DONE; 122: } 123: 124: ############################################### 125: 126: sub get_posted_cgi { 127: my ($r,$fields) = @_; 128: 129: my $buffer; 130: if ($r->header_in('Content-length')) { 131: $r->read($buffer,$r->header_in('Content-length'),0); 132: } 133: my $content_type = $r->header_in('Content-type'); 134: if ($content_type !~ m{^multipart/form-data}) { 135: my @pairs=split(/&/,$buffer); 136: my $pair; 137: foreach $pair (@pairs) { 138: my ($name,$value) = split(/=/,$pair); 139: $value =~ tr/+/ /; 140: $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; 141: $name =~ tr/+/ /; 142: $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; 143: if (ref($fields) eq 'ARRAY') { 144: next if (!grep(/^\Q$name\E$/,@{$fields})); 145: } 146: &Apache::loncommon::add_to_env("form.$name",$value); 147: } 148: } else { 149: my ($contentsep) = ($content_type =~ /boundary=\"?([^\";,]+)\"?/); 150: my @lines = split (/\n/,$buffer); 151: my $name=''; 152: my $value=''; 153: my $fname=''; 154: my $fmime=''; 155: my $i; 156: for ($i=0;$i<=$#lines;$i++) { 157: if ($lines[$i]=~/^--\Q$contentsep\E/) { 158: if ($name) { 159: chomp($value); 160: if (($r->uri eq '/adm/portfolio') && 161: ($name eq 'uploaddoc')) { 162: if (length($value) == 1) { 163: $value=~s/[\r\n]$//; 164: } 165: } 166: if (ref($fields) eq 'ARRAY') { 167: next if (!grep(/^\Q$name\E$/,@{$fields})); 168: } 169: if ($fname) { 170: if ($env{'form.symb'} ne '') { 171: my $size = (length($value))/(1024.0 * 1024.0); 172: if (&upload_size_allowed($name,$size,$fname) eq 'ok') { 173: $env{"form.$name.filename"}=$fname; 174: $env{"form.$name.mimetype"}=$fmime; 175: &Apache::loncommon::add_to_env("form.$name",$value); 176: } 177: } else { 178: $env{"form.$name.filename"}=$fname; 179: $env{"form.$name.mimetype"}=$fmime; 180: &Apache::loncommon::add_to_env("form.$name",$value); 181: } 182: } else { 183: $value=~s/\s+$//s; 184: &Apache::loncommon::add_to_env("form.$name",$value); 185: } 186: } 187: if ($i<$#lines) { 188: $i++; 189: $lines[$i]=~ 190: /Content\-Disposition\:\s*form\-data\;\s*name\=\"([^\"]+)\"/i; 191: $name=$1; 192: $value=''; 193: if ($lines[$i]=~/filename\=\"([^\"]+)\"/i) { 194: $fname=$1; 195: if 196: ($lines[$i+1]=~/Content\-Type\:\s*([\w\-\/]+)/i) { 197: $fmime=$1; 198: $i++; 199: } else { 200: $fmime=''; 201: } 202: } else { 203: $fname=''; 204: $fmime=''; 205: } 206: $i++; 207: } 208: } else { 209: $value.=$lines[$i]."\n"; 210: } 211: } 212: } 213: # 214: # Digested POSTed values 215: # 216: # Remember the way this was originally done (GET or POST) 217: # 218: $env{'request.method'}=$ENV{'REQUEST_METHOD'}; 219: # 220: # There may also be stuff in the query string 221: # Tell subsequent handlers that this was GET, not POST, so they can access query string. 222: # Also, unset POSTed content length to cover all tracks. 223: # 224: 225: $r->method_number(M_GET); 226: 227: $r->method('GET'); 228: $r->headers_in->unset('Content-length'); 229: } 230: 231: =pod 232: 233: =item upload_size_allowed() 234: 235: Perform size checks for file uploads to essayresponse items in course context. 236: 237: Add form.HWFILESIZE.$part_$id to %env with file size (MB) 238: If file exceeds maximum allowed size, add form.HWFILETOOBIG.$part_$id to %env. 239: 240: =cut 241: 242: sub upload_size_allowed { 243: my ($name,$size,$fname) = @_; 244: if ($name =~ /^HWFILE(\w+)$/) { 245: my $ident = $1; 246: my $item = 'HWFILESIZE'.$ident; 247: my $savesize = sprintf("%.6f",$size); 248: &Apache::loncommon::add_to_env("form.$item",$savesize); 249: my $maxsize= &Apache::lonnet::EXT("resource.$ident.maxfilesize"); 250: if (!$maxsize) { 251: $maxsize = 10.0; # FIXME This should become a domain configuration. 252: } 253: if ($size > $maxsize) { 254: my $warn = 'HWFILETOOBIG'.$ident; 255: &Apache::loncommon::add_to_env("form.$warn",$fname); 256: return; 257: } 258: } 259: return 'ok'; 260: } 261: 262: =pod 263: 264: =item sso_login() 265: 266: handle the case of the single sign on user, at this point $r->user 267: will be set and valid now need to find the loncapa user info and possibly 268: balance them 269: returns OK if it was a SSO and user was handled 270: undef if not SSO or no means to hanle the user 271: 272: =cut 273: 274: sub sso_login { 275: my ($r,$handle) = @_; 276: 277: my $lonidsdir=$r->dir_config('lonIDsDir'); 278: if (($r->user eq '') || 279: (defined($env{'user.name'}) && (defined($env{'user.domain'})) 280: && ($handle ne ''))) { 281: # not an SSO case or already logged in 282: return undef; 283: } 284: 285: my ($user) = ($r->user =~ m/([a-zA-Z0-9_\-@.]*)/); 286: 287: my $query = $r->args; 288: my %form; 289: if ($query) { 290: my @items = ('role','symb'); 291: &Apache::loncommon::get_unprocessed_cgi($query,\@items); 292: foreach my $item (@items) { 293: if (defined($env{'form.'.$item})) { 294: $form{$item} = $env{'form.'.$item}; 295: } 296: } 297: } 298: 299: my $domain = $r->dir_config('lonSSOUserDomain'); 300: if ($domain eq '') { 301: $domain = $r->dir_config('lonDefDomain'); 302: } 303: my $home=&Apache::lonnet::homeserver($user,$domain); 304: if ($home !~ /(con_lost|no_host|no_such_host)/) { 305: &Apache::lonnet::logthis(" SSO authorized user $user "); 306: my ($is_balancer,$otherserver) = 307: &Apache::lonnet::check_loadbalancing($user,$domain); 308: if ($is_balancer) { 309: # login but immediately go to switch server to find us a new 310: # machine 311: &Apache::lonauth::success($r,$user,$domain,$home,'noredirect'); 312: $env{'request.sso.login'} = 1; 313: if (defined($r->dir_config("lonSSOReloginServer"))) { 314: $env{'request.sso.reloginserver'} = 315: $r->dir_config('lonSSOReloginServer'); 316: } 317: my $redirecturl = '/adm/switchserver'; 318: if ($otherserver ne '') { 319: $redirecturl .= '?otherserver='.$otherserver; 320: } 321: $r->internal_redirect($redirecturl); 322: $r->set_handlers('PerlHandler'=> undef); 323: } else { 324: # need to login them in, so generate the need data that 325: # migrate expects to do login 326: my %info=('ip' => $r->connection->remote_ip(), 327: 'domain' => $domain, 328: 'username' => $user, 329: 'server' => $r->dir_config('lonHostID'), 330: 'sso.login' => 1 331: ); 332: foreach my $item ('role','symb') { 333: if (exists($form{$item})) { 334: $info{$item} = $form{$item}; 335: } 336: } 337: if ($r->dir_config("ssodirecturl") == 1) { 338: $info{'origurl'} = $r->uri; 339: } 340: if (defined($r->dir_config("lonSSOReloginServer"))) { 341: $info{'sso.reloginserver'} = 342: $r->dir_config('lonSSOReloginServer'); 343: } 344: my $token = 345: &Apache::lonnet::tmpput(\%info, 346: $r->dir_config('lonHostID')); 347: $env{'form.token'} = $token; 348: $r->internal_redirect('/adm/migrateuser'); 349: $r->set_handlers('PerlHandler'=> undef); 350: } 351: return OK; 352: } elsif (defined($r->dir_config('lonSSOUserUnknownRedirect'))) { 353: &Apache::lonnet::logthis(" SSO authorized unknown user $user "); 354: $r->subprocess_env->set('SSOUserUnknown' => $user); 355: $r->subprocess_env->set('SSOUserDomain' => $domain); 356: my @cancreate; 357: my %domconfig = 358: &Apache::lonnet::get_dom('configuration',['usercreation'],$domain); 359: if (ref($domconfig{'usercreation'}) eq 'HASH') { 360: if (ref($domconfig{'usercreation'}{'cancreate'}) eq 'HASH') { 361: if (ref($domconfig{'usercreation'}{'cancreate'}{'selfcreate'}) eq 'ARRAY') { 362: @cancreate = @{$domconfig{'usercreation'}{'cancreate'}{'selfcreate'}}; 363: } elsif (($domconfig{'usercreation'}{'cancreate'}{'selfcreate'} ne 'none') && 364: ($domconfig{'usercreation'}{'cancreate'}{'selfcreate'} ne '')) { 365: @cancreate = ($domconfig{'usercreation'}{'cancreate'}{'selfcreate'}); 366: } 367: } 368: } 369: if (grep(/^sso$/,@cancreate)) { 370: $r->internal_redirect('/adm/createaccount'); 371: } else { 372: $r->internal_redirect($r->dir_config('lonSSOUserUnknownRedirect')); 373: } 374: $r->set_handlers('PerlHandler'=> undef); 375: return OK; 376: } 377: return undef; 378: } 379: 380: sub handler { 381: my $r = shift; 382: my $requrl=$r->uri; 383: if (&Apache::lonnet::is_domainimage($requrl)) { 384: return OK; 385: } 386: 387: if ($requrl =~ m{^/res/adm/pages/[^/]+\.(gif|png)$}) { 388: return OK; 389: } 390: 391: my $handle = &Apache::lonnet::check_for_valid_session($r); 392: 393: my $result = &sso_login($r,$handle); 394: if (defined($result)) { 395: return $result; 396: } 397: 398: my ($is_balancer,$otherserver); 399: 400: if ($handle eq '') { 401: unless (($requrl eq '/adm/switchserver') && (!$r->is_initial_req())) { 402: $r->log_reason("Cookie $handle not valid", $r->filename); 403: } 404: } elsif ($handle ne '') { 405: 406: # ------------------------------------------------------ Initialize Environment 407: my $lonidsdir=$r->dir_config('lonIDsDir'); 408: &Apache::lonnet::transfer_profile_to_env($lonidsdir,$handle); 409: 410: # --------------------------------------------------------- Initialize Language 411: 412: &Apache::lonlocal::get_language_handle($r); 413: 414: } 415: 416: # -------------------------------------------------- Should be a valid user now 417: if ($env{'user.name'} ne '' && $env{'user.domain'} ne '') { 418: # -------------------------------------------------------------- Resource State 419: 420: my ($cdom,$cnum); 421: if ($env{'request.course.id'}) { 422: $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; 423: $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; 424: } 425: if ($requrl=~/^\/+(res|uploaded)\//) { 426: $env{'request.state'} = "published"; 427: } else { 428: $env{'request.state'} = 'unknown'; 429: } 430: $env{'request.filename'} = $r->filename; 431: $env{'request.noversionuri'} = &Apache::lonnet::deversion($requrl); 432: my $suppext; 433: if ($requrl =~ m{^/adm/wrapper/ext/}) { 434: my $query = $r->args; 435: if ($query) { 436: my $preserved; 437: foreach my $pair (split(/&/,$query)) { 438: my ($name, $value) = split(/=/,$pair); 439: unless ($name eq 'symb') { 440: $preserved .= $pair.'&'; 441: } 442: if (($env{'request.course.id'}) && ($name eq 'folderpath')) { 443: if ($value =~ /^supplemental/) { 444: $suppext = 1; 445: } 446: } 447: } 448: $preserved =~ s/\&$//; 449: if ($preserved) { 450: $env{'request.external.querystring'} = $preserved; 451: } 452: } 453: } elsif ($env{'request.course.id'} && 454: (($requrl =~ m{^/adm/$match_domain/$match_username/aboutme$}) || 455: ($requrl =~ m{^/public/$cdom/$cnum/syllabus$}))) { 456: my $query = $r->args; 457: if ($query) { 458: foreach my $pair (split(/&/,$query)) { 459: my ($name, $value) = split(/=/,$pair); 460: if ($name eq 'folderpath') { 461: if ($value =~ /^supplemental/) { 462: $suppext = 1; 463: } 464: } 465: } 466: } 467: } 468: # -------------------------------------------------------- Load POST parameters 469: 470: &Apache::lonacc::get_posted_cgi($r); 471: 472: # ------------------------------------------------------ Check if load balancer 473: 474: my $checkexempt; 475: if ($env{'user.loadbalexempt'} eq $r->dir_config('lonHostID')) { 476: if ($env{'user.loadbalcheck.time'} + 600 > time) { 477: $checkexempt = 1; 478: } 479: } 480: unless ($checkexempt) { 481: ($is_balancer,$otherserver) = 482: &Apache::lonnet::check_loadbalancing($env{'user.name'}, 483: $env{'user.domain'}); 484: } 485: if ($is_balancer) { 486: $r->set_handlers('PerlResponseHandler'=> 487: [\&Apache::switchserver::handler]); 488: if ($otherserver ne '') { 489: $env{'form.otherserver'} = $otherserver; 490: } 491: } 492: 493: # ---------------------------------------------------------------- Check access 494: my $now = time; 495: if ($requrl !~ m{^/(?:adm|public|prtspool)/} 496: || $requrl =~ /^\/adm\/.*\/(smppg|bulletinboard)(\?|$ )/x) { 497: my $access=&Apache::lonnet::allowed('bre',$requrl); 498: if ($access eq '1') { 499: $env{'user.error.msg'}="$requrl:bre:0:0:Choose Course"; 500: return HTTP_NOT_ACCEPTABLE; 501: } 502: if ($access eq 'A') { 503: &Apache::restrictedaccess::setup_handler($r); 504: return OK; 505: } 506: if ($access eq 'B') { 507: &Apache::blockedaccess::setup_handler($r); 508: return OK; 509: } 510: if (($access ne '2') && ($access ne 'F')) { 511: if ($requrl =~ m{^/res/}) { 512: $access = &Apache::lonnet::allowed('bro',$requrl); 513: if ($access ne 'F') { 514: if ($requrl eq '/res/lib/templates/simpleproblem.problem/smpedit') { 515: $access = &Apache::lonnet::allowed('bre','/res/lib/templates/simpleproblem.problem'); 516: if ($access ne 'F') { 517: $env{'user.error.msg'}="$requrl:bre:1:1:Access Denied"; 518: return HTTP_NOT_ACCEPTABLE; 519: } 520: } else { 521: $env{'user.error.msg'}="$requrl:bre:1:1:Access Denied"; 522: return HTTP_NOT_ACCEPTABLE; 523: } 524: } 525: } else { 526: $env{'user.error.msg'}="$requrl:bre:1:1:Access Denied"; 527: return HTTP_NOT_ACCEPTABLE; 528: } 529: } 530: } 531: if ($requrl =~ m|^/prtspool/|) { 532: my $start='/prtspool/'.$env{'user.name'}.'_'. 533: $env{'user.domain'}; 534: if ($requrl !~ /^\Q$start\E/) { 535: $env{'user.error.msg'}="$requrl:bre:1:1:Access Denied"; 536: return HTTP_NOT_ACCEPTABLE; 537: } 538: } 539: if ($requrl =~ m|^/zipspool/|) { 540: my $start='/zipspool/zipout/'.$env{'user.name'}.":". 541: $env{'user.domain'}; 542: if ($requrl !~ /^\Q$start\E/) { 543: $env{'user.error.msg'}="$requrl:bre:1:1:Access Denied"; 544: return HTTP_NOT_ACCEPTABLE; 545: } 546: } 547: if ($env{'user.name'} eq 'public' && 548: $env{'user.domain'} eq 'public' && 549: $requrl !~ m{^/+(res|public|uploaded)/} && 550: $requrl !~ m{^/adm/[^/]+/[^/]+/aboutme/portfolio$ }x && 551: $requrl !~ m{^/adm/blockingstatus/.*$} && 552: $requrl !~ m{^/+adm/(help|logout|restrictedaccess|randomlabel\.png)}) { 553: $env{'request.querystring'}=$r->args; 554: $env{'request.firsturl'}=$requrl; 555: return FORBIDDEN; 556: } 557: # ------------------------------------------------------------- This is allowed 558: if ($env{'request.course.id'}) { 559: &Apache::lonnet::countacc($requrl); 560: $requrl=~/\.(\w+)$/; 561: my $query=$r->args; 562: if ((&Apache::loncommon::fileembstyle($1) eq 'ssi') || 563: ($requrl=~/^\/adm\/.*\/(aboutme|smppg|bulletinboard)(\?|$ )/x) || 564: ($requrl=~/^\/adm\/wrapper\//) || 565: ($requrl=~m|^/adm/coursedocs/showdoc/|) || 566: ($requrl=~m|\.problem/smpedit$|) || 567: ($requrl=~/^\/public\/.*\/syllabus$/) || 568: ($requrl=~/^\/adm\/(viewclasslist|navmaps)$/) || 569: ($requrl=~/^\/adm\/.*\/aboutme\/portfolio(\?|$)/)) { 570: # ------------------------------------- This is serious stuff, get symb and log 571: my $symb; 572: if ($query) { 573: &Apache::loncommon::get_unprocessed_cgi($query,['symb','folderpath']); 574: } 575: if ($env{'form.symb'}) { 576: $symb=&Apache::lonnet::symbclean($env{'form.symb'}); 577: if ($requrl =~ m|^/adm/wrapper/| 578: || $requrl =~ m|^/adm/coursedocs/showdoc/|) { 579: my ($map,$mid,$murl)=&Apache::lonnet::decode_symb($symb); 580: &Apache::lonnet::symblist($map,$murl => [$murl,$mid], 581: 'last_known' =>[$murl,$mid]); 582: } elsif ((&Apache::lonnet::symbverify($symb,$requrl)) || 583: (($requrl=~m|(.*)/smpedit$|) && 584: &Apache::lonnet::symbverify($symb,$1)) || 585: (($requrl=~m|(.*/aboutme)/portfolio$|) && 586: &Apache::lonnet::symbverify($symb,$1))) { 587: my ($map,$mid,$murl)=&Apache::lonnet::decode_symb($symb); 588: &Apache::lonnet::symblist($map,$murl => [$murl,$mid], 589: 'last_known' =>[$murl,$mid]); 590: } else { 591: $r->log_reason('Invalid symb for '.$requrl.': '. 592: $symb); 593: $env{'user.error.msg'}= 594: "$requrl:bre:1:1:Invalid Access"; 595: return HTTP_NOT_ACCEPTABLE; 596: } 597: } else { 598: if ($requrl=~m{^(/adm/.*/aboutme)/portfolio$}) { 599: $requrl = $1; 600: } 601: unless ($suppext) { 602: $symb=&Apache::lonnet::symbread($requrl); 603: if (&Apache::lonnet::is_on_map($requrl) && $symb && 604: !&Apache::lonnet::symbverify($symb,$requrl)) { 605: $r->log_reason('Invalid symb for '.$requrl.': '.$symb); 606: $env{'user.error.msg'}= 607: "$requrl:bre:1:1:Invalid Access"; 608: return HTTP_NOT_ACCEPTABLE; 609: } 610: if ($symb) { 611: my ($map,$mid,$murl)= 612: &Apache::lonnet::decode_symb($symb); 613: &Apache::lonnet::symblist($map,$murl =>[$murl,$mid], 614: 'last_known' =>[$murl,$mid]); 615: } 616: } 617: } 618: $env{'request.symb'}=$symb; 619: &Apache::lonnet::courseacclog($symb); 620: } else { 621: # ------------------------------------------------------- This is other content 622: &Apache::lonnet::courseacclog($requrl); 623: } 624: if ($requrl =~ m{^/+uploaded/\Q$cdom\E/\Q$cnum\E/(docs|supplemental)/.+\.html?$}) { 625: if (&Apache::lonnet::allowed('mdc',$env{'request.course.id'})) { 626: if ($query) { 627: &Apache::loncommon::get_unprocessed_cgi($query,['forceedit']); 628: if ($env{'form.forceedit'}) { 629: $env{'request.state'} = 'edit'; 630: } 631: } 632: } 633: } 634: } 635: return OK; 636: } else { 637: my $defdom=$r->dir_config('lonDefDomain'); 638: ($is_balancer,$otherserver) = 639: &Apache::lonnet::check_loadbalancing(undef,$defdom); 640: if ($is_balancer) { 641: $r->set_handlers('PerlResponseHandler'=> 642: [\&Apache::switchserver::handler]); 643: if ($otherserver ne '') { 644: $env{'form.otherserver'} = $otherserver; 645: } 646: } 647: } 648: # -------------------------------------------- See if this is a public resource 649: if ($requrl=~m|^/+adm/+help/+|) { 650: return OK; 651: } 652: # ------------------------------------ See if this is a viewable portfolio file 653: if (&Apache::lonnet::is_portfolio_url($requrl)) { 654: my $access=&Apache::lonnet::allowed('bre',$requrl); 655: if ($access eq 'A') { 656: &Apache::restrictedaccess::setup_handler($r); 657: return OK; 658: } 659: if (($access ne '2') && ($access ne 'F')) { 660: $env{'user.error.msg'}="$requrl:bre:1:1:Access Denied"; 661: return HTTP_NOT_ACCEPTABLE; 662: } 663: } 664: 665: # -------------------------------------------------------------- Not authorized 666: $requrl=~/\.(\w+)$/; 667: # if ((&Apache::loncommon::fileembstyle($1) eq 'ssi') || 668: # ($requrl=~/^\/adm\/(roles|logout|email|menu|remote)/) || 669: # ($requrl=~m|^/prtspool/|)) { 670: # -------------------------- Store where they wanted to go and get login screen 671: $env{'request.querystring'}=$r->args; 672: $env{'request.firsturl'}=$requrl; 673: return FORBIDDEN; 674: # } else { 675: # --------------------------------------------------------------------- Goodbye 676: # return HTTP_BAD_REQUEST; 677: # } 678: } 679: 680: 1; 681: __END__ 682: 683: =pod 684: 685: =back 686: 687: =cut 688: