Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.340 and 1.341

version 1.340, 2003/03/14 19:35:54 version 1.341, 2003/03/18 07:26:49
Line 1870  sub eget { Line 1870  sub eget {
    return %returnhash;     return %returnhash;
 }  }
   
   # ---------------------------------------------- Custom access rule evaluation
   
   sub customaccess {
       my ($priv,$uri)=@_;
       my $access=0;
       foreach (split(/\s*\,\s*/,&metadata($uri,'rule_rights'))) {
    my ($effect,$realm,$content)=split(/\:/,$_);
           &logthis('testing '.$effect.' '.$realm.' '.$content);
       }
       return $access;
   }
   
 # ------------------------------------------------- Check for a user privilege  # ------------------------------------------------- Check for a user privilege
   
 sub allowed {  sub allowed {
Line 1908  sub allowed { Line 1920  sub allowed {
             # Library role, so allow browsing of resources in this domain.              # Library role, so allow browsing of resources in this domain.
             return 'F';              return 'F';
         }          }
           if ($copyright eq 'custom') {
       unless (&customaccess($priv,$uri)) { return ''; }
           }
     }      }
     # Domain coordinator is trying to create a course      # Domain coordinator is trying to create a course
     if (($priv eq 'ccc') && ($ENV{'request.role'} =~ /^dc\./)) {      if (($priv eq 'ccc') && ($ENV{'request.role'} =~ /^dc\./)) {
Line 2125  sub allowed { Line 2140  sub allowed {
   
    if ($thisallowed=~/R/) {     if ($thisallowed=~/R/) {
        my $rolecode=(split(/\./,$ENV{'request.role'}))[0];         my $rolecode=(split(/\./,$ENV{'request.role'}))[0];
        my $filename=$perlvar{'lonDocRoot'}.'/res/'.$uri.'.meta';         if (&metadata($uri,'roledeny')=~/$rolecode/) {
        if (-e $filename) {    &log($ENV{'user.domain'},$ENV{'user.name'},$ENV{'user.host'},
            my @content;  
            {  
      my $fh=Apache::File->new($filename);  
              @content=<$fh>;  
    }  
            if (join('',@content)=~  
                     /\<roledeny[^\>]*\>[^\<]*$rolecode[^\<]*\<\/roledeny\>/) {  
        &log($ENV{'user.domain'},$ENV{'user.name'},$ENV{'user.host'},  
                     'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode);                      'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode);
            return '';            return '';
   
            }  
        }         }
    }     }
   

Removed from v.1.340  
changed lines
  Added in v.1.341


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