--- loncom/auth/lonacc.pm 2000/06/05 20:28:17 1.6 +++ loncom/auth/lonacc.pm 2000/10/31 19:26:21 1.12 @@ -1,12 +1,12 @@ # The LearningOnline Network # Cookie Based Access Handler # 5/21/99,5/22,5/29,5/31,6/15,16/11,22/11, -# 01/06,01/13,05/31,06/01 Gerd Kortemeyer +# 01/06,01/13,05/31,06/01,09/06,09/25,09/28,10/30 Gerd Kortemeyer package Apache::lonacc; use strict; -use Apache::Constants qw(:common :http); +use Apache::Constants qw(:common :http :methods); use Apache::File; use Apache::lonnet; use CGI::Cookie(); @@ -34,15 +34,34 @@ sub handler { for ($envi=0;$envi<=$#profile;$envi++) { chomp($profile[$envi]); my ($envname,$envvalue)=split(/=/,$profile[$envi]); - $r->subprocess_env("$envname" => "$envvalue"); - $ENV{$envname}=$envvalue; + $ENV{$envname} = $envvalue; } - $r->subprocess_env("user.environment" => "$lonidsdir/$handle.id", - "request.state" => "published", - "request.filename" => $r->filename); + $ENV{'user.environment'} = "$lonidsdir/$handle.id"; + $ENV{'request.state'} = "published"; + $ENV{'request.filename'} = $r->filename; + +# ---- Figure out referer, first from HTTP_REFERER, then cache, then wild guess + + my $referer=''; + if ($referer=$r->header_in('Referer')) { + $ENV{'HTTP_REFERER'}=$referer; + } else { + $ENV{'HTTP_REFERER'}=$ENV{'httpref.'.$requrl}; + unless($ENV{'HTTP_REFERER'}) { + my $pathpart=$requrl; + $pathpart=~s/\/[\w\.]*$//; + map { + if ($_=~/^httpref.$pathpart/) { + $ENV{'HTTP_REFERER'}=$ENV{$_}; + } + } keys %ENV; + } + } # -------------------------------------------------------- Load POST parameters + + my $buffer; $r->read($buffer,$r->header_in('Content-length')); @@ -52,17 +71,27 @@ sub handler { my ($name,$value) = split(/=/,$pair); $value =~ tr/+/ /; $value =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; - $r->subprocess_env("form.$name" => $value); + $name =~ tr/+/ /; + $name =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg; + $ENV{"form.$name"}=$value; } + $r->method_number(M_GET); + $r->method('GET'); + $r->headers_in->unset('Content-length'); # ---------------------------------------------------------------- Check access if ($requrl!~/^\/adm\//) { - if (&Apache::lonnet::allowed('bre',$requrl) eq '') { - $ENV{'user.error.msg'}="$requrl:bre:1:1:Access denied"; - return HTTP_NOT_ACCEPTABLE; - } + my $access=&Apache::lonnet::allowed('bre',$requrl); + if ($access eq '1') { + $ENV{'user.error.msg'}="$requrl:bre:0:0:Choose Course"; + return HTTP_NOT_ACCEPTABLE; + } + if (($access ne '2') && ($access ne 'F')) { + $ENV{'user.error.msg'}="$requrl:bre:1:1:Access Denied"; + return HTTP_NOT_ACCEPTABLE; + } } return OK; } else {