--- loncom/lonnet/perl/lonnet.pm 2001/08/09 16:43:06 1.146 +++ loncom/lonnet/perl/lonnet.pm 2001/08/12 01:18:37 1.148 @@ -122,7 +122,7 @@ # 5/30 H. K. Ng # 6/1 Gerd Kortemeyer # July Guy Albertelli -# 8/4,8/7,8/8,8/9 Gerd Kortemeyer +# 8/4,8/7,8/8,8/9,8/11 Gerd Kortemeyer package Apache::lonnet; @@ -1108,10 +1108,22 @@ sub allowed { } } - if (($ENV{'HTTP_REFERER'}) && ($checkreferer)) { - my $refuri=$ENV{'HTTP_REFERER'}; - $refuri=~s/^http\:\/\/$ENV{'request.host'}//i; - $refuri=&declutter($refuri); + if ($checkreferer) { + my $refuri=$ENV{'httpref.'.$uri}; + + unless ($refuri) { + map { + if ($_=~/^httpref\..*\*/) { + my $pattern=$_; + $pattern=~s/\*/\[\^\/\]\+/g; + $pattern=~s/\//\\\//g; + if ($uri=~/$pattern/) { + $refuri=$ENV{$_}; + } + } + } keys %ENV; + } + if ($refuri) { my @uriparts=split(/\//,$refuri); my $filename=$uriparts[$#uriparts]; my $pathname=$refuri; @@ -1129,6 +1141,7 @@ sub allowed { } } } + } } } @@ -1674,7 +1687,7 @@ sub condval { # --------------------------------------------------------- Value of a Variable sub EXT { - my $varname=shift; + my ($varname,$symbparm)=@_; unless ($varname) { return ''; } my ($realm,$space,$qualifier,@therest)=split(/\./,$varname); my $rest; @@ -1740,7 +1753,12 @@ sub EXT { # ----------------------------------------------------- Cascading lookup scheme - my $symbp=&symbread(); + my $symbp; + if ($symbparm) { + $symbp=$symbparm; + } else { + $symbp=&symbread(); + } my $mapp=(split(/\_\_\_/,$symbp))[0]; my $symbparm=$symbp.'.'.$spacequalifierrest; @@ -1833,10 +1851,12 @@ sub EXT { unless ($space eq '0') { my ($part,$id)=split(/\_/,$space); if ($id) { - my $partgeneral=&EXT('resource.'.$part.'.'.$qualifierrest); + my $partgeneral=&EXT('resource.'.$part.'.'.$qualifierrest, + $symbparm); if ($partgeneral) { return $partgeneral; } } else { - my $resourcegeneral=&EXT('resource.0.'.$qualifierrest); + my $resourcegeneral=&EXT('resource.0.'.$qualifierrest, + $symbparm); if ($resourcegeneral) { return $resourcegeneral; } } }