[BACK]Return to lonnet.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / lonnet / perl

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.151 and 1.152

version 1.151, 2001/08/17 19:50:28 version 1.152, 2001/08/18 14:17:50
Line 122 Line 122
 # 5/30 H. K. Ng  # 5/30 H. K. Ng
 # 6/1 Gerd Kortemeyer  # 6/1 Gerd Kortemeyer
 # July Guy Albertelli  # July Guy Albertelli
 # 8/4,8/7,8/8,8/9,8/11,8/16,8/17 Gerd Kortemeyer  # 8/4,8/7,8/8,8/9,8/11,8/16,8/17,8/18 Gerd Kortemeyer
   
 package Apache::lonnet;  package Apache::lonnet;
   
Line 1111  sub eget { Line 1111  sub eget {
   
 sub allowed {  sub allowed {
     my ($priv,$uri)=@_;      my ($priv,$uri)=@_;
   
       my $orguri=$uri;
     $uri=&declutter($uri);      $uri=&declutter($uri);
   
 # Free bre access to adm and meta resources  # Free bre access to adm and meta resources
Line 1185  sub allowed { Line 1187  sub allowed {
        }         }
                 
        if ($checkreferer) {         if ($checkreferer) {
   my $refuri=$ENV{'httpref.'.$uri};    my $refuri=$ENV{'httpref.'.$orguri};
   
             unless ($refuri) {              unless ($refuri) {
                 map {                  map {
Line 1193  sub allowed { Line 1195  sub allowed {
  my $pattern=$_;   my $pattern=$_;
                         $pattern=~s/\*/\[\^\/\]\+/g;                          $pattern=~s/\*/\[\^\/\]\+/g;
                         $pattern=~s/\//\\\//g;                          $pattern=~s/\//\\\//g;
                         if ($uri=~/$pattern/) {                          if ($orguri=~/$pattern/) {
     $refuri=$ENV{$_};      $refuri=$ENV{$_};
                         }                          }
                     }                      }
                 } keys %ENV;                  } keys %ENV;
             }              }
          if ($refuri) {            if ($refuri) { 
     $refuri=&declutter($refuri);
           my @uriparts=split(/\//,$refuri);            my @uriparts=split(/\//,$refuri);
           my $filename=$uriparts[$#uriparts];            my $filename=$uriparts[$#uriparts];
           my $pathname=$refuri;            my $pathname=$refuri;
           $pathname=~s/\/$filename$//;            $pathname=~s/\/$filename$//;
           my @filenameparts=split(/\./,$uri);  
           if (&fileembstyle($filenameparts[$#filenameparts]) ne 'ssi') {  
             if ($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$pathname}=~              if ($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$pathname}=~
               /\&$filename\:([\d\|]+)\&/) {                /\&$filename\:([\d\|]+)\&/) {
               my $refstatecond=$1;                my $refstatecond=$1;
Line 1215  sub allowed { Line 1216  sub allowed {
                   $uri=$refuri;                    $uri=$refuri;
                   $statecond=$refstatecond;                    $statecond=$refstatecond;
               }                }
             }  
           }            }
         }          }
        }         }
Removed from v.1.151  
changed lines
  Added in v.1.152

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>