Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.1453 and 1.1454

version 1.1453, 2021/05/10 18:13:50 version 1.1454, 2021/05/10 20:09:25
Line 8530  sub allowed { Line 8530  sub allowed {
 #  #
   
 # Possibly locked functionality, check all courses  # 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  # 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/) {      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)) {          foreach my $envkey (keys(%env)) {
            if ($envkey=~/^user\.role\.(st|ta)\.([^\.]*)/) {             if ($envkey=~/^user\.role\.(st|ta)\.([^\.]*)/) {
                my $courseid=$2;                 my $courseid=$2;
Line 8544  sub allowed { Line 8572  sub allowed {
                    my ($start,$end) = split(/\./,$env{$envkey});                     my ($start,$end) = split(/\./,$env{$envkey});
                    next unless (($now >= $start) && (!$end || $end > $now));                     next unless (($now >= $start) && (!$end || $end > $now));
                }                 }
                  
                my $expiretime=600;                 my $expiretime=600;
                if ($env{'request.role'} eq $roleid) {                 if ($env{'request.role'} eq $roleid) {
   $expiretime=120;    $expiretime=120;

Removed from v.1.1453  
changed lines
  Added in v.1.1454


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