[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.51 and 1.52

version 1.51, 2000/10/26 15:29:17 version 1.52, 2000/10/28 17:26:35
Line 66 Line 66
 # 08/22,08/28,08/31,09/01,09/02,09/04,09/05,09/25,09/28,09/30 Gerd Kortemeyer  # 08/22,08/28,08/31,09/01,09/02,09/04,09/05,09/25,09/28,09/30 Gerd Kortemeyer
 # 10/04 Gerd Kortemeyer  # 10/04 Gerd Kortemeyer
 # 10/04 Guy Albertelli  # 10/04 Guy Albertelli
 # 10/06,10/09,10/10,10/11,10/14,10/20,10/23,10/25,10/26 Gerd Kortemeyer  # 10/06,10/09,10/10,10/11,10/14,10/20,10/23,10/25,10/26,10/27,10/28 
   # Gerd Kortemeyer
   
 package Apache::lonnet;  package Apache::lonnet;
   
Line 714  sub eget { Line 715  sub eget {
   
 sub allowed {  sub allowed {
     my ($priv,$uri)=@_;      my ($priv,$uri)=@_;
     $uri=~s/^\/res//;      $uri=&declutter($uri);
     $uri=~s/^\///;  
   
 # Free bre access to adm resources  # Free bre access to adm resources
   
Line 723  sub allowed { Line 723  sub allowed {
  return 'F';   return 'F';
     }      }
   
 # Gather priviledges over system and domain  
   
     my $thisallowed='';      my $thisallowed='';
     if ($ENV{'user.priv./'}=~/$priv\&([^\:]*)/) {      my $statecond=0;
       my $courseprivid='';
   
   # Course
   
       if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'}=~/$priv\&([^\:]*)/) {
          $thisallowed.=$1;
       }
   
   # Domain
   
       if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.(split(/\//,$uri))[0].'/'}
          =~/$priv\&([^\:]*)/) {
        $thisallowed.=$1;         $thisallowed.=$1;
     }      }
     if ($ENV{'user.priv./'.(split(/\//,$uri))[0].'/'}=~/$priv\&([^\:]*)/) {  
   # Course: uri itself is a course
   
       if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.$uri}
          =~/$priv\&([^\:]*)/) {
        $thisallowed.=$1;         $thisallowed.=$1;
     }      }
   
 # Full access at system or domain level? Exit.  # Full access at system, domain or course-wide level? Exit.
   
     if ($thisallowed=~/F/) {      if ($thisallowed=~/F/) {
  return 'F';   return 'F';
     }      }
   
 # The user does not have full access at system or domain level  # If this is generating or modifying users, exit with special codes
 # Course level access control  
   
 # uri itself refering to a course?      if (':csu:cdc:ccc:cin:cta:cep:ccr:cst:cad:cli:cau:cdg:'=~/\:$priv\:/) {
        return $thisallowed;
     if ($uri=~/\.course$/) {      }
        if ($ENV{'user.priv./'.$uri}=~/$priv\&([^\:]*)/) {  #
           $thisallowed.=$1;  # Gathered so far: system, domain and course wide priviledges
   #
   # Course: See if uri or referer is an individual resource that is part of 
   # the course
   
       if ($ENV{'request.course.id'}) {
          $courseprivid=$ENV{'request.course.id'};
          if ($ENV{'request.course.sec'}) {
             $courseprivid.='/'.$ENV{'request.course.sec'};
        }         }
 # Full access on course level? Exit.         $courseprivid=~s/\_/\//;
        if ($thisallowed=~/F/) {         my $checkreferer=1;
   return 'F';         my @uriparts=split(/\//,$uri);
          my $filename=$uriparts[$#uriparts];
          my $pathname=$uri;
          $pathname=~s/\/$filename$//;
          if ($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$pathname}=~
              /\&$filename\:(\d+)\&/) {
              $statecond=$1;
              if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.$courseprivid}
                  =~/$priv\&([^\:]*)/) {
                  $thisallowed.=$1;
                  $checkreferer=0;
              }
        }         }
          if (($ENV{'HTTP_REFERER'}) && ($checkreferer)) {
 # uri is refering to an individual resource; user needs to be in a course            my @uriparts=split(/\//,&declutter($ENV{'HTTP_REFERER'}));
             my $filename=$uriparts[$#uriparts];
    } else {            my $pathname=$uri;
             $pathname=~s/\/$filename$//;
        unless(defined($ENV{'request.course.id'})) {            if ($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$pathname}=~
    return '1';                /\&$filename\:(\d+)\&/) {
                 $statecond=$1;
                 if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.$courseprivid}
                     =~/$priv\&([^\:]*)/) {
                     $thisallowed.=$1;
                 }
             }
        }         }
      }
   
 # Get access priviledges for course  #
   # Gathered now: all priviledges that could apply, and condition number
   # 
   #
   # Full or no access?
   #
   
        if ($ENV{'user.priv./'.$ENV{'request.course.id'}}=~/$priv\&([^\:]*)/) {      if ($thisallowed=~/F/) {
           $thisallowed.=$1;   return 'F';
        }      }
   
 # See if resource or referer is part of this course  
             
        my @uriparts=split(/\//,$uri);  
        my $urifile=$uriparts[$#uriparts];  
        $urifile=~/\.(\w+)$/;  
        my $uritype=$1;  
        $#uriparts--;  
        my $uripath=join('/',@uriparts);  
        my $uricond=-1;  
        if ($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$uripath}=~  
    /\&$urifile\:(\d+)\&/) {  
    $uricond=$1;  
        } elsif (($fe{$uritype} eq 'emb') || ($fe{$uritype} eq 'img')) {  
   my $refuri=$ENV{'HTTP_REFERER'};  
           $refuri=~s/^\/res//;  
           $refuri=~s/^\///;  
           @uriparts=split(/\//,$refuri);  
           $urifile=$uriparts[$#uriparts];  
           $#uriparts--;  
           $uripath=join('/',@uriparts);  
           if ($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$uripath}=~  
      /\&$urifile\:(\d+)\&/) {  
      $uricond=$1;  
   }  
        }  
   
        if ($uricond>=0) {      unless ($thisallowed) {
           return '';
       }
   
 # The resource is part of the course  # Restrictions exist, deal with them
 # If user had full access on course level, go ahead  #
   #   C:according to course preferences
   #   R:according to resource settings
   #   L:unless locked
   #   X:according to user session state
   #
   
   # Possibly locked functionality, check all courses
   
       my $envkey;
       if ($thisallowed=~/L/) {
           foreach $envkey (keys %ENV) {
              if ($envkey=~/^user\.role\.st\.([^\.]*)/) {
          my ($cdom,$cnum,$csec)=split(/\//,$1);
                  my %locks=();
                  map {
                      my ($name,$value)=split(/\=/,$_);
                      $locks{&unescape($name)}=&unescape($value);
                  } split(/\&/,&reply('get:'.$cdom.':'.$cnum.
                    ':environment:'.&escape('priv.'.$priv.'.lock.sections').
                                ':'.&escape('priv.'.$priv.'.lock.expire').
                                ':'.&escape('res.'.$uri.'.lock.sections').
        ':'.&escape('res.'.$uri.'.lock.expire'),
                     &homeserver($cnum,$cdom)));
                  if (($locks{'res.'.$uri.'.lock.sections'}=~/\,$csec\,/) ||
                      ($locks{'res.'.$uri.'.lock.sections'} eq 'all')) {
      if ($locks{'res.'.$uri.'.lock.expire'}>time) {
                          &log('Locked by res: '.$priv.' for '.$uri.' due to '.
                               $cdom.'/'.$cnum.'/'.$csec.' expire '.
                               $locks{'priv.'.$priv.'.lock.expire'});
          return '';
                      }
                  }
                  if (($locks{'priv.'.$priv.'.lock.sections'}=~/\,$csec\,/) ||
                      ($locks{'priv.'.$priv.'.lock.sections'} eq 'all')) {
      if ($locks{'priv.'.$priv.'.lock.expire'}>time) {
                          &log('Locked by priv: '.$priv.' for '.$uri.' due to '.
                               $cdom.'/'.$cnum.'/'.$csec.' expire '.
                               $locks{'priv.'.$priv.'.lock.expire'});
          return '';
                      }
                  }
      }
          }
       }
      
   #
   # Rest of the restrictions depend on selected course
   #
   
       unless ($ENV{'request.course.id'}) {
          return '1';
       }
   
            if ($thisallowed=~/F/) {  #
        return 'F';  # Now user is definitely in a course
            }  #
   
 # Restricted by state?  # Restricted by state?
   
            if ($thisallowed=~/X/) {     if ($thisallowed=~/X/) {
       if (&condval($uricond)) {        if (&condval($statecond)) {
          return '2';   return '2';
               } else {        } else {
                  return '';           return '';
               }        }
    }     }
        }  
     }     return 'F';
     return $thisallowed;  
 }  }
   
 # ---------------------------------------------------------- Refresh State Info  # ---------------------------------------------------------- Refresh State Info
Removed from v.1.51  
changed lines
  Added in v.1.52

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