--- loncom/lonnet/perl/lonnet.pm 2000/10/28 19:26:07 1.53 +++ loncom/lonnet/perl/lonnet.pm 2000/10/30 16:32:06 1.54 @@ -66,8 +66,8 @@ # 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 Guy Albertelli -# 10/06,10/09,10/10,10/11,10/14,10/20,10/23,10/25,10/26,10/27,10/28 -# 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; @@ -499,6 +499,8 @@ sub coursedescription { if ($chome ne 'no_host') { my $rep=reply("dump:$cdomain:$cnum:environment",$chome); if ($rep ne 'con_lost') { + my $normalid=$courseid; + $normalid=~s/\//\_/g; my %envhash=(); my %returnhash=('home' => $chome, 'domain' => $cdomain, @@ -508,13 +510,12 @@ sub coursedescription { $name=&unescape($name); $value=&unescape($value); $returnhash{$name}=$value; - my $normalid=$courseid; - $normalid=~s/\//\_/g; $envhash{'course.'.$normalid.'.'.$name}=$value; } split(/\&/,$rep); $returnhash{'url'}='/res/'.declutter($returnhash{'url'}); $returnhash{'fn'}=$perlvar{'lonDaemons'}.'/tmp/'. $ENV{'user.name'}.'_'.$cdomain.'_'.$cnum; + $envhash{'course.'.$normalid.'.last_cache'}=time; &appenv(%envhash); return %returnhash; } @@ -717,9 +718,9 @@ sub allowed { my ($priv,$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'; } @@ -776,7 +777,7 @@ sub allowed { my $pathname=$uri; $pathname=~s/\/$filename$//; if ($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$pathname}=~ - /\&$filename\:(\d+)\&/) { + /\&$filename\:([\d\|]+)\&/) { $statecond=$1; if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.$courseprivid} =~/$priv\&([^\:]*)/) { @@ -793,7 +794,7 @@ sub allowed { my @filenameparts=split(/\./,$filename); if (&fileembstyle($filenameparts[$#filenameparts]) ne 'ssi') { if ($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$pathname}=~ - /\&$filename\:(\d+)\&/) { + /\&$filename\:([\d\|]+)\&/) { my $refstatecond=$1; if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.$courseprivid} =~/$priv\&([^\:]*)/) { @@ -830,37 +831,39 @@ sub allowed { # # 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\.([^\.]*)/) { - 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) { + 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 '. - $locks{'priv.'.$priv.'.lock.expire'}); + $ENV{$prefix.'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) { + 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 '. - $locks{'priv.'.$priv.'.lock.expire'}); + $ENV{$prefix.'priv.'.$priv.'.lock.expire'}); return ''; } } @@ -884,17 +887,33 @@ sub allowed { # Course preferences if ($thisallowed=~/C/) { -# -# Registered course preferences from environment -# + my $rolecode=(split(/\./,$ENV{'request.role'}))[0]; + 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 if ($thisallowed=~/R/) { -# -# Resource Metadata -# + 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)=~ + /\]*\>[^\<]*$rolecode[^\<]*\<\/roledeny\>/) { + &log('Denied by role: '.$priv.' for '.$uri.' as '.$rolecode); + return ''; + + } + } } # Restricted by state? @@ -1094,8 +1113,16 @@ sub directcondval { sub condval { my $condidx=shift; 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 (defined($ENV{'acc.cond.'.$ENV{'request.course.id'}.'.'.$condidx})) { + if ($allpathcond) { my $operand='|'; my @stack; map { @@ -1118,8 +1145,7 @@ sub condval { $result=$result>$new?$result:$new; } } - } ($ENV{'acc.cond.'.$ENV{'request.course.id'}.'.'.$condidx}=~ - /(\d+|\(|\)|\&|\|)/g); + } ($allpathcond=~/(\d+|\(|\)|\&|\|)/g); } } return $result;