[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.55

version 1.51, 2000/10/26 15:29:17 version 1.55, 2000/10/30 22:45:21
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,10/29, 
   # 10/30 Gerd Kortemeyer
   
 package Apache::lonnet;  package Apache::lonnet;
   
Line 498  sub coursedescription { Line 499  sub coursedescription {
     if ($chome ne 'no_host') {      if ($chome ne 'no_host') {
        my $rep=reply("dump:$cdomain:$cnum:environment",$chome);         my $rep=reply("dump:$cdomain:$cnum:environment",$chome);
        if ($rep ne 'con_lost') {         if ($rep ne 'con_lost') {
    my %cachehash=();             my $normalid=$courseid;
              $normalid=~s/\//\_/g;
              my %envhash=();
            my %returnhash=('home'   => $chome,              my %returnhash=('home'   => $chome, 
                            'domain' => $cdomain,                             'domain' => $cdomain,
                            'num'    => $cnum);                             'num'    => $cnum);
Line 507  sub coursedescription { Line 510  sub coursedescription {
                $name=&unescape($name);                 $name=&unescape($name);
                $value=&unescape($value);                 $value=&unescape($value);
                $returnhash{$name}=$value;                 $returnhash{$name}=$value;
                if ($name eq 'description') {                 $envhash{'course.'.$normalid.'.'.$name}=$value;
    $cachehash{$courseid}=$value;  
                }  
            } split(/\&/,$rep);             } split(/\&/,$rep);
            $returnhash{'url'}='/res/'.declutter($returnhash{'url'});             $returnhash{'url'}='/res/'.declutter($returnhash{'url'});
            $returnhash{'fn'}=$perlvar{'lonDaemons'}.'/tmp/'.             $returnhash{'fn'}=$perlvar{'lonDaemons'}.'/tmp/'.
        $ENV{'user.name'}.'_'.$cdomain.'_'.$cnum;         $ENV{'user.name'}.'_'.$cdomain.'_'.$cnum;
    put ('nohist_coursedescriptions',%cachehash);             $envhash{'course.'.$normalid.'.last_cache'}=time;
              &appenv(%envhash);
            return %returnhash;             return %returnhash;
        }         }
     }      }
Line 714  sub eget { Line 716  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 and meta resources
   
     if (($uri=~/^adm\//) && ($priv eq 'bre')) {      if ((($uri=~/^adm\//) || ($uri=~/\.meta$/)) && ($priv eq 'bre')) {
  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;         $thisallowed.=$1;
     }      }
     if ($ENV{'user.priv./'.(split(/\//,$uri))[0].'/'}=~/$priv\&([^\:]*)/) {  
   # Domain
   
       if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.(split(/\//,$uri))[0].'/'}
          =~/$priv\&([^\:]*)/) {
        $thisallowed.=$1;         $thisallowed.=$1;
     }      }
   
 # Full access at system or domain level? Exit.  # Course: uri itself is a course
   
       if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.$uri}
          =~/$priv\&([^\:]*)/) {
          $thisallowed.=$1;
       }
   
   # 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;
              }
        }         }
   
 # uri is refering to an individual resource; user needs to be in a course         if (($ENV{'HTTP_REFERER'}) && ($checkreferer)) {
     my $refuri=$ENV{'HTTP_REFERER'};
             $refuri=~s/^http\:\/\/$ENV{'request.host'}//i;
             $refuri=&declutter($refuri);
             my @uriparts=split(/\//,$refuri);
             my $filename=$uriparts[$#uriparts];
             my $pathname=$refuri;
             $pathname=~s/\/$filename$//;
             my @filenameparts=split(/\./,$uri);
             if (&fileembstyle($filenameparts[$#filenameparts]) ne 'ssi') {
               if ($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$pathname}=~
                 /\&$filename\:([\d\|]+)\&/) {
                 my $refstatecond=$1;
                 if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.$courseprivid}
                     =~/$priv\&([^\:]*)/) {
                     $thisallowed.=$1;
                     $uri=$refuri;
                     $statecond=$refstatecond;
                 }
               }
             }
          }
      }
   
    } else {  #
   # Gathered now: all priviledges that could apply, and condition number
   # 
   #
   # Full or no access?
   #
   
        unless(defined($ENV{'request.course.id'})) {      if ($thisallowed=~/F/) {
    return '1';   return 'F';
        }      }
   
 # Get access priviledges for course      unless ($thisallowed) {
           return '';
       }
   
        if ($ENV{'user.priv./'.$ENV{'request.course.id'}}=~/$priv\&([^\:]*)/) {  # Restrictions exist, deal with them
           $thisallowed.=$1;  #
   #   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
   # Locks might take effect only after 10 minutes cache expiration for other
   # courses, and 2 minutes for current course
   
       my $envkey;
       if ($thisallowed=~/L/) {
           foreach $envkey (keys %ENV) {
              if ($envkey=~/^user\.role\.(st|ta)\.([^\.]*)/) {
                  my $courseid=$2;
                  my $roleid=$1.'.'.$2;
                  my $expiretime=600;
                  if ($ENV{'request.role'} eq $roleid) {
     $expiretime=120;
                  }
          my ($cdom,$cnum,$csec)=split(/\//,$courseid);
                  my $prefix='course.'.$cdom.'_'.$cnum.'.';
                  if ((time-$ENV{$prefix.'last_cache'})>$expiretime) {
      &coursedescription($courseid);
                  }
                  if (($ENV{$prefix.'res.'.$uri.'.lock.sections'}=~/\,$csec\,/)
                   || ($ENV{$prefix.'res.'.$uri.'.lock.sections'} eq 'all')) {
      if ($ENV{$prefix.'res.'.$uri.'.lock.expire'}>time) {
                          &log('Locked by res: '.$priv.' for '.$uri.' due to '.
                               $cdom.'/'.$cnum.'/'.$csec.' expire '.
                               $ENV{$prefix.'priv.'.$priv.'.lock.expire'});
          return '';
                      }
                  }
                  if (($ENV{$prefix.'priv.'.$priv.'.lock.sections'}=~/\,$csec\,/)
                   || ($ENV{$prefix.'priv.'.$priv.'.lock.sections'} eq 'all')) {
      if ($ENV{'priv.'.$priv.'.lock.expire'}>time) {
                          &log('Locked by priv: '.$priv.' for '.$uri.' due to '.
                               $cdom.'/'.$cnum.'/'.$csec.' expire '.
                               $ENV{$prefix.'priv.'.$priv.'.lock.expire'});
          return '';
                      }
                  }
      }
        }         }
       }
      
   #
   # Rest of the restrictions depend on selected course
   #
   
 # See if resource or referer is part of this course      unless ($ENV{'request.course.id'}) {
                    return '1';
        my @uriparts=split(/\//,$uri);      }
        my $urifile=$uriparts[$#uriparts];  
        $urifile=~/\.(\w+)$/;  #
        my $uritype=$1;  # Now user is definitely in a course
        $#uriparts--;  #
        my $uripath=join('/',@uriparts);  
        my $uricond=-1;  
        if ($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$uripath}=~  # Course preferences
    /\&$urifile\:(\d+)\&/) {  
    $uricond=$1;     if ($thisallowed=~/C/) {
        } elsif (($fe{$uritype} eq 'emb') || ($fe{$uritype} eq 'img')) {         my $rolecode=(split(/\./,$ENV{'request.role'}))[0];
   my $refuri=$ENV{'HTTP_REFERER'};         if ($ENV{'course.'.$ENV{'request.course.id'}.'.'.$priv.'.roles.denied'}
           $refuri=~s/^\/res//;     =~/\,$rolecode\,/) {
           $refuri=~s/^\///;             &log('Denied by role: '.$priv.' for '.$uri.' as '.$rolecode.' in '.
           @uriparts=split(/\//,$refuri);                  $ENV{'request.course.id'});
           $urifile=$uriparts[$#uriparts];             return '';
           $#uriparts--;  
           $uripath=join('/',@uriparts);  
           if ($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$uripath}=~  
      /\&$urifile\:(\d+)\&/) {  
      $uricond=$1;  
   }  
        }         }
      }
   
        if ($uricond>=0) {  # Resource preferences
   
 # The resource is part of the course     if ($thisallowed=~/R/) {
 # If user had full access on course level, go ahead         my $rolecode=(split(/\./,$ENV{'request.role'}))[0];
          my $filename=$perlvar{'lonDocRoot'}.'/res/'.$uri.'.meta';
          if (-e $filename) {
              my @content;
              {
        my $fh=Apache::File->new($filename);
                @content=<$fh>;
      }
              if (join('',@content)=~
                       /\<roledeny[^\>]*\>[^\<]*$rolecode[^\<]*\<\/roledeny\>/) {
          &log('Denied by role: '.$priv.' for '.$uri.' as '.$rolecode);
              return '';
   
            if ($thisallowed=~/F/) {  
        return 'F';  
            }             }
          }
      }
   
 # 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
Line 1000  sub directcondval { Line 1116  sub directcondval {
 sub condval {  sub condval {
     my $condidx=shift;      my $condidx=shift;
     my $result=0;      my $result=0;
       my $allpathcond='';
       map {
          if (defined($ENV{'acc.cond.'.$ENV{'request.course.id'}.'.'.$_})) {
      $allpathcond.=
                  '('.$ENV{'acc.cond.'.$ENV{'request.course.id'}.'.'.$_}.')|';
          }
       } split(/\|/,$condidx);
       $allpathcond=~s/\|$//;
     if ($ENV{'request.course.id'}) {      if ($ENV{'request.course.id'}) {
        if (defined($ENV{'acc.cond.'.$ENV{'request.course.id'}.'.'.$condidx})) {         if ($allpathcond) {
           my $operand='|';            my $operand='|';
   my @stack;    my @stack;
           map {            map {
Line 1024  sub condval { Line 1148  sub condval {
                      $result=$result>$new?$result:$new;                       $result=$result>$new?$result:$new;
                   }                                      }                  
               }                }
           } ($ENV{'acc.cond.'.$ENV{'request.course.id'}.'.'.$condidx}=~            } ($allpathcond=~/(\d+|\(|\)|\&|\|)/g);
              /(\d+|\(|\)|\&|\|)/g);  
        }         }
     }      }
     return $result;      return $result;
Removed from v.1.51  
changed lines
  Added in v.1.55

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