[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.53 and 1.54

version 1.53, 2000/10/28 19:26:07 version 1.54, 2000/10/30 16:32:06
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,10/27,10/28   # 10/06,10/09,10/10,10/11,10/14,10/20,10/23,10/25,10/26,10/27,10/28,10/29, 
 # Gerd Kortemeyer  # 10/30 Gerd Kortemeyer
   
 package Apache::lonnet;  package Apache::lonnet;
   
Line 499  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 $normalid=$courseid;
              $normalid=~s/\//\_/g;
            my %envhash=();             my %envhash=();
            my %returnhash=('home'   => $chome,              my %returnhash=('home'   => $chome, 
                            'domain' => $cdomain,                             'domain' => $cdomain,
Line 508  sub coursedescription { Line 510  sub coursedescription {
                $name=&unescape($name);                 $name=&unescape($name);
                $value=&unescape($value);                 $value=&unescape($value);
                $returnhash{$name}=$value;                 $returnhash{$name}=$value;
                my $normalid=$courseid;  
                $normalid=~s/\//\_/g;  
                $envhash{'course.'.$normalid.'.'.$name}=$value;                 $envhash{'course.'.$normalid.'.'.$name}=$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;
              $envhash{'course.'.$normalid.'.last_cache'}=time;
            &appenv(%envhash);             &appenv(%envhash);
            return %returnhash;             return %returnhash;
        }         }
Line 717  sub allowed { Line 718  sub allowed {
     my ($priv,$uri)=@_;      my ($priv,$uri)=@_;
     $uri=&declutter($uri);      $uri=&declutter($uri);
   
 # 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';
     }      }
   
Line 776  sub allowed { Line 777  sub allowed {
        my $pathname=$uri;         my $pathname=$uri;
        $pathname=~s/\/$filename$//;         $pathname=~s/\/$filename$//;
        if ($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$pathname}=~         if ($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$pathname}=~
            /\&$filename\:(\d+)\&/) {             /\&$filename\:([\d\|]+)\&/) {
            $statecond=$1;             $statecond=$1;
            if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.$courseprivid}             if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.$courseprivid}
                =~/$priv\&([^\:]*)/) {                 =~/$priv\&([^\:]*)/) {
Line 793  sub allowed { Line 794  sub allowed {
           my @filenameparts=split(/\./,$filename);            my @filenameparts=split(/\./,$filename);
           if (&fileembstyle($filenameparts[$#filenameparts]) ne 'ssi') {            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;
               if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.$courseprivid}                if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.$courseprivid}
                   =~/$priv\&([^\:]*)/) {                    =~/$priv\&([^\:]*)/) {
Line 830  sub allowed { Line 831  sub allowed {
 #  #
   
 # Possibly locked functionality, check all courses  # 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;      my $envkey;
     if ($thisallowed=~/L/) {      if ($thisallowed=~/L/) {
         foreach $envkey (keys %ENV) {          foreach $envkey (keys %ENV) {
            if ($envkey=~/^user\.role\.st\.([^\.]*)/) {             if ($envkey=~/^user\.role\.(st|ta)\.([^\.]*)/) {
        my ($cdom,$cnum,$csec)=split(/\//,$1);                 my $courseid=$2;
                my %locks=();                 my $roleid=$1.'.'.$2;
                map {                 my $expiretime=600;
                    my ($name,$value)=split(/\=/,$_);                 if ($ENV{'request.role'} eq $roleid) {
                    $locks{&unescape($name)}=&unescape($value);    $expiretime=120;
                } split(/\&/,&reply('get:'.$cdom.':'.$cnum.                 }
                  ':environment:'.&escape('priv.'.$priv.'.lock.sections').         my ($cdom,$cnum,$csec)=split(/\//,$courseid);
                              ':'.&escape('priv.'.$priv.'.lock.expire').                 my $prefix='course.'.$cdom.'_'.$cnum.'.';
                              ':'.&escape('res.'.$uri.'.lock.sections').                 if ((time-$ENV{$prefix.'last_cache'})>$expiretime) {
      ':'.&escape('res.'.$uri.'.lock.expire'),     &coursedescription($courseid);
                   &homeserver($cnum,$cdom)));                 }
                if (($locks{'res.'.$uri.'.lock.sections'}=~/\,$csec\,/) ||                 if (($ENV{$prefix.'res.'.$uri.'.lock.sections'}=~/\,$csec\,/)
                    ($locks{'res.'.$uri.'.lock.sections'} eq 'all')) {                  || ($ENV{$prefix.'res.'.$uri.'.lock.sections'} eq 'all')) {
    if ($locks{'res.'.$uri.'.lock.expire'}>time) {     if ($ENV{$prefix.'res.'.$uri.'.lock.expire'}>time) {
                        &log('Locked by res: '.$priv.' for '.$uri.' due to '.                         &log('Locked by res: '.$priv.' for '.$uri.' due to '.
                             $cdom.'/'.$cnum.'/'.$csec.' expire '.                              $cdom.'/'.$cnum.'/'.$csec.' expire '.
                             $locks{'priv.'.$priv.'.lock.expire'});                              $ENV{$prefix.'priv.'.$priv.'.lock.expire'});
        return '';         return '';
                    }                     }
                }                 }
                if (($locks{'priv.'.$priv.'.lock.sections'}=~/\,$csec\,/) ||                 if (($ENV{$prefix.'priv.'.$priv.'.lock.sections'}=~/\,$csec\,/)
                    ($locks{'priv.'.$priv.'.lock.sections'} eq 'all')) {                  || ($ENV{$prefix.'priv.'.$priv.'.lock.sections'} eq 'all')) {
    if ($locks{'priv.'.$priv.'.lock.expire'}>time) {     if ($ENV{'priv.'.$priv.'.lock.expire'}>time) {
                        &log('Locked by priv: '.$priv.' for '.$uri.' due to '.                         &log('Locked by priv: '.$priv.' for '.$uri.' due to '.
                             $cdom.'/'.$cnum.'/'.$csec.' expire '.                              $cdom.'/'.$cnum.'/'.$csec.' expire '.
                             $locks{'priv.'.$priv.'.lock.expire'});                              $ENV{$prefix.'priv.'.$priv.'.lock.expire'});
        return '';         return '';
                    }                     }
                }                 }
Line 884  sub allowed { Line 887  sub allowed {
 # Course preferences  # Course preferences
   
    if ($thisallowed=~/C/) {     if ($thisallowed=~/C/) {
 #         my $rolecode=(split(/\./,$ENV{'request.role'}))[0];
 # Registered course preferences from environment         if ($ENV{'course.'.$ENV{'request.course.id'}.'.'.$priv.'.roles.denied'}
 #     =~/\,$rolecode\,/) {
              &log('Denied by role: '.$priv.' for '.$uri.' as '.$rolecode.' in '.
                   $ENV{'request.course.id'});
              return '';
          }
    }     }
   
 # Resource preferences  # Resource preferences
   
    if ($thisallowed=~/R/) {     if ($thisallowed=~/R/) {
 #         my $rolecode=(split(/\./,$ENV{'request.role'}))[0];
 # Resource Metadata         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 '';
   
              }
          }
    }     }
   
 # Restricted by state?  # Restricted by state?
Line 1094  sub directcondval { Line 1113  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 1118  sub condval { Line 1145  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.53  
changed lines
  Added in v.1.54

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