--- loncom/lonnet/perl/lonnet.pm 2000/10/28 17:26:35 1.52 +++ 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,7 +499,9 @@ sub coursedescription { if ($chome ne 'no_host') { my $rep=reply("dump:$cdomain:$cnum:environment",$chome); if ($rep ne 'con_lost') { - my %cachehash=(); + my $normalid=$courseid; + $normalid=~s/\//\_/g; + my %envhash=(); my %returnhash=('home' => $chome, 'domain' => $cdomain, 'num' => $cnum); @@ -508,14 +510,13 @@ sub coursedescription { $name=&unescape($name); $value=&unescape($value); $returnhash{$name}=$value; - if ($name eq 'description') { - $cachehash{$courseid}=$value; - } + $envhash{'course.'.$normalid.'.'.$name}=$value; } split(/\&/,$rep); $returnhash{'url'}='/res/'.declutter($returnhash{'url'}); $returnhash{'fn'}=$perlvar{'lonDaemons'}.'/tmp/'. $ENV{'user.name'}.'_'.$cdomain.'_'.$cnum; - put ('nohist_coursedescriptions',%cachehash); + $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\&([^\:]*)/) { @@ -785,17 +786,23 @@ sub allowed { } } if (($ENV{'HTTP_REFERER'}) && ($checkreferer)) { - my @uriparts=split(/\//,&declutter($ENV{'HTTP_REFERER'})); + my $refuri=&declutter($ENV{'HTTP_REFERER'}); + my @uriparts=split(/\//,$refuri); my $filename=$uriparts[$#uriparts]; - my $pathname=$uri; + my $pathname=$refuri; $pathname=~s/\/$filename$//; - if ($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$pathname}=~ - /\&$filename\:(\d+)\&/) { - $statecond=$1; + my @filenameparts=split(/\./,$filename); + 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; } + } } } } @@ -824,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 ''; } } @@ -874,6 +883,39 @@ sub allowed { # Now user is definitely in a course # + +# Course preferences + + if ($thisallowed=~/C/) { + 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/) { + 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? if ($thisallowed=~/X/) { @@ -1071,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 { @@ -1095,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;