--- loncom/lonnet/perl/lonnet.pm 2021/05/10 18:13:50 1.1453 +++ loncom/lonnet/perl/lonnet.pm 2021/05/10 20:09:25 1.1454 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1453 2021/05/10 18:13:50 raeburn Exp $ +# $Id: lonnet.pm,v 1.1454 2021/05/10 20:09:25 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -8530,11 +8530,39 @@ sub allowed { # # Possibly locked functionality, check all courses +# In roles.tab, L (unless locked) available for bre, pch, plc, pac and sma. # Locks might take effect only after 10 minutes cache expiration for other -# courses, and 2 minutes for current course +# courses, and 2 minutes for current course, in which user has st or ta role +# which is neither expired nor a future role (unless current course). + my ($needlockcheck,$now,$crsonly); if ($thisallowed=~/L/) { - my $now = time; + $now = time; + if ($priv eq 'bre') { + if ($uri ne '') { + if ($orguri =~ m{^/+res/}) { + if ($uri =~ m{^lib/templates/}) { + if ($env{'request.course.id'}) { + $crsonly = 1; + $needlockcheck = 1; + } + } else { + $needlockcheck = 1; + } + } elsif ($env{'request.course.id'}) { + my ($crsdom,$crsnum) = split('_',$env{'request.course.id'}); + if (($uri =~ m{^(adm|uploaded|public)/$crsdom/$crsnum/}) || + ($uri =~ m{^adm/$match_domain/$match_username/\d+/(smppg|bulletinboard)$})) { + $crsonly = 1; + } + $needlockcheck = 1; + } + } + } elsif (($priv eq 'pch') || ($priv eq 'plc') || ($priv eq 'pac') || ($priv eq 'sma')) { + $needlockcheck = 1; + } + } + if ($needlockcheck) { foreach my $envkey (keys(%env)) { if ($envkey=~/^user\.role\.(st|ta)\.([^\.]*)/) { my $courseid=$2; @@ -8544,6 +8572,7 @@ sub allowed { my ($start,$end) = split(/\./,$env{$envkey}); next unless (($now >= $start) && (!$end || $end > $now)); } + my $expiretime=600; if ($env{'request.role'} eq $roleid) { $expiretime=120;