--- loncom/lonnet/perl/lonnet.pm	2020/07/01 20:08:58	1.1423
+++ loncom/lonnet/perl/lonnet.pm	2020/09/28 00:10:29	1.1424
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1423 2020/07/01 20:08:58 raeburn Exp $
+# $Id: lonnet.pm,v 1.1424 2020/09/28 00:10:29 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -8036,7 +8036,7 @@ sub customaccess {
 # ------------------------------------------------- Check for a user privilege
 
 sub allowed {
-    my ($priv,$uri,$symb,$role,$clientip,$noblockcheck)=@_;
+    my ($priv,$uri,$symb,$role,$clientip,$noblockcheck,$ignorecache)=@_;
     my $ver_orguri=$uri;
     $uri=&deversion($uri);
     my $orguri=$uri;
@@ -8267,7 +8267,7 @@ sub allowed {
                 } elsif ($noblockcheck) {
                     $thisallowed.=$value;
                 } else {
-                    my @blockers = &has_comm_blocking($priv,$symb,$uri);
+                    my @blockers = &has_comm_blocking($priv,$symb,$uri,$ignorecache);
                     if (@blockers > 0) {
                         $thisallowed = 'B';
                     } else {
@@ -8290,7 +8290,7 @@ sub allowed {
                         } elsif ($noblockcheck) {
                             $thisallowed='F';
                         } else {
-                            my @blockers = &has_comm_blocking($priv,$symb,$refuri);
+                            my @blockers = &has_comm_blocking($priv,$symb,$refuri,$ignorecache);
                             if (@blockers > 0) {
                                 $thisallowed = 'B';
                             } else {
@@ -8363,7 +8363,7 @@ sub allowed {
                    if ($noblockcheck) {
                        $thisallowed.=$value;
                    } else {
-                       my @blockers = &has_comm_blocking($priv,$symb,$uri);
+                       my @blockers = &has_comm_blocking($priv,$symb,$uri,$ignorecache);
                        if (@blockers > 0) {
                            $thisallowed = 'B';
                        } else {
@@ -8376,7 +8376,7 @@ sub allowed {
                $checkreferer=0;
            }
        }
-       
+
        if ($checkreferer) {
 	  my $refuri=$env{'httpref.'.$orguri};
             unless ($refuri) {
@@ -8408,7 +8408,7 @@ sub allowed {
                       } elsif ($noblockcheck) {
                           $thisallowed.=$value;
                       } else {
-                          my @blockers = &has_comm_blocking($priv,$symb,$refuri);
+                          my @blockers = &has_comm_blocking($priv,'',$refuri,$ignorecache);
                           if (@blockers > 0) {
                               $thisallowed = 'B';
                           } else {
@@ -8494,7 +8494,7 @@ sub allowed {
 	   }
        }
     }
-   
+
 #
 # Rest of the restrictions depend on selected course
 #
@@ -8663,6 +8663,10 @@ sub constructaccess {
 #
 # User for whom data are being temporarily cached.
 my $cacheduser='';
+# Course for which data are being temporarily cached.
+my $cachedcid='';
+# List of blocks passed to &get_commblock_resources();
+my $cachedblocks='';
 # Cached blockers for this user (a hash of blocking items). 
 my %cachedblockers=();
 # When the data were last cached.
@@ -8672,13 +8676,22 @@ sub load_all_blockers {
     my ($uname,$udom,$blocks)=@_;
     if (($uname ne '') && ($udom ne '')) { 
         if (($cacheduser eq $uname.':'.$udom) &&
-            (abs($cachedlast-time)<5)) {
+            ($cachedcid eq $env{'request.course.id'}) &&
+            (abs($cachedlast-time)<5) &&
+            (((ref($blocks) eq 'HASH') &&
+              ($cachedblocks eq join(',',sort(keys(%{$blocks}))))) ||
+             (!ref($blocks) && $cachedblocks eq ''))) {
             return;
         }
     }
     $cachedlast=time;
     $cacheduser=$uname.':'.$udom;
+    $cachedcid=$env{'request.course.id'};
     %cachedblockers = &get_commblock_resources($blocks);
+    if ((ref($blocks) eq 'HASH') && (keys(%{$blocks}) > 0)) {
+        $cachedblocks = join(',',sort(keys(%{$blocks})));
+    }
+    return;
 }
 
 sub get_comm_blocks {
@@ -8816,7 +8829,7 @@ sub get_commblock_resources {
 }
 
 sub has_comm_blocking {
-    my ($priv,$symb,$uri,$blocks) = @_;
+    my ($priv,$symb,$uri,$nosymbcache,$blocked,$blocks) = @_;
     my @blockers;
     return unless ($env{'request.course.id'});
     return unless ($priv eq 'bre');
@@ -8826,7 +8839,7 @@ sub has_comm_blocking {
     return unless (keys(%cachedblockers) > 0);
     my (%possibles,@symbs);
     if (!$symb) {
-        $symb = &symbread($uri,1,1,1,\%possibles);
+        $symb = &symbread($uri,1,1,'',\%possibles,$nosymbcache);
     }
     if ($symb) {
         @symbs = ($symb);
@@ -8840,9 +8853,11 @@ sub has_comm_blocking {
         foreach my $block (keys(%cachedblockers)) {
             if ($block =~ /^firstaccess____(.+)$/) {
                 my $item = $1;
-                if (($item eq $map) || ($item eq $symb)) {
-                    $noblock = 1;
-                    last;
+                unless ($blocked) {
+                    if (($item eq $map) || ($item eq $symb)) {
+                        $noblock = 1;
+                        last;
+                    }
                 }
             }
             if (ref($cachedblockers{$block}) eq 'HASH') {
@@ -8853,18 +8868,20 @@ sub has_comm_blocking {
                         }
                     }
                 }
-            }
-            if (ref($cachedblockers{$block}{'maps'}) eq 'HASH') {
-                if ($cachedblockers{$block}{'maps'}{$map}) {
-                    unless (grep(/^\Q$block\E$/,@blockers)) {
-                        push(@blockers,$block);
+                if (ref($cachedblockers{$block}{'maps'}) eq 'HASH') {
+                    if ($cachedblockers{$block}{'maps'}{$map}) {
+                        unless (grep(/^\Q$block\E$/,@blockers)) {
+                            push(@blockers,$block);
+                        }
                     }
                 }
             }
         }
     }
-    return if ($noblock);
-    return @blockers;
+    unless ($noblock) { 
+        return @blockers;
+    }
+    return;
 }
 }
 
@@ -13292,19 +13309,26 @@ sub deversion {
 # ------------------------------------------------------ Return symb list entry
 
 sub symbread {
-    my ($thisfn,$donotrecurse,$ignorecachednull,$checkforblock,$possibles)=@_;
+    my ($thisfn,$donotrecurse,$ignorecachednull,$checkforblock,$possibles,
+        $nocache)=@_;
     my $cache_str='request.symbread.cached.'.$thisfn;
-    if (defined($env{$cache_str})) {
-        if ($ignorecachednull) {
-            return $env{$cache_str} unless ($env{$cache_str} eq '');
-        } else {
-            return $env{$cache_str};
+    if (defined($env{$cache_str}) && !$nocache) {
+        unless (ref($possibles) eq 'HASH') {
+            if ($ignorecachednull) {
+                return $env{$cache_str} unless ($env{$cache_str} eq '');
+            } else {
+                return $env{$cache_str};
+            }
         }
     }
 # no filename provided? try from environment
     unless ($thisfn) {
         if ($env{'request.symb'}) {
-	    return $env{$cache_str}=&symbclean($env{'request.symb'});
+            if ($nocache) {
+                return &symbclean($env{'request.symb'});
+            } else {
+                return $env{$cache_str}=&symbclean($env{'request.symb'});
+            }
 	}
 	$thisfn=$env{'request.filename'};
     }
@@ -13312,7 +13336,11 @@ sub symbread {
 # is that filename actually a symb? Verify, clean, and return
     if ($thisfn=~/\_\_\_\d+\_\_\_(.*)$/) {
 	if (&symbverify($thisfn,$1)) {
-	    return $env{$cache_str}=&symbclean($thisfn);
+            if ($nocache) {
+                return &symbclean($thisfn);
+            } else {
+	        return $env{$cache_str}=&symbclean($thisfn);
+            }
 	}
     }
     $thisfn=declutter($thisfn);
@@ -13327,10 +13355,18 @@ sub symbread {
 	if ($targetfn =~ m|^adm/wrapper/(ext/.*)|) {
 	    $targetfn=$1;
 	}
-        if (tie(%hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db',
-                      &GDBM_READER(),0640)) {
-	    $syval=$hash{$targetfn};
-            untie(%hash);
+        unless ($nocache) {
+            if (tie(%hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db',
+                          &GDBM_READER(),0640)) {
+	        $syval=$hash{$targetfn};
+                untie(%hash);
+            }
+            if ($syval) {
+                my @blockers = &has_comm_blocking('bre',$syval,$thisfn,$nocache);
+                if (@blockers) {
+                    $syval='';
+                }
+            }
         }
 # ---------------------------------------------------------- There was an entry
         if ($syval) {
@@ -13363,13 +13399,17 @@ sub symbread {
 		     $syval=&encode_symb($bighash{'map_id_'.$mapid},
 						    $resid,$thisfn);
                      if (ref($possibles) eq 'HASH') {
-                         $possibles->{$syval} = 1;    
+                         unless ($bighash{'randomout_'.$ids} || $env{'request.role.adv'}) {
+                             $possibles->{$syval} = 1;
+                         }
                      }
                      if ($checkforblock) {
-                         my @blockers = &has_comm_blocking('bre',$syval,$bighash{'src_'.$ids});
-                         if (@blockers) {
-                             $syval = '';
-                             return;
+                         unless ($bighash{'randomout_'.$ids} || $env{'request.role.adv'}) {
+                             my @blockers = &has_comm_blocking('bre',$syval,$bighash{'src_'.$ids});
+                             if (@blockers) {
+                                 $syval = '';
+                                 return;
+                             }
                          }
                      }
                  } elsif ((!$donotrecurse) || ($checkforblock) || (ref($possibles) eq 'HASH')) { 
@@ -13388,12 +13428,13 @@ sub symbread {
                              if ($bighash{'map_type_'.$mapid} ne 'page') {
                                  my $poss_syval=&encode_symb($bighash{'map_id_'.$mapid},
 						             $resid,$thisfn);
-                                 if (ref($possibles) eq 'HASH') {
-                                     $possibles->{$syval} = 1;
-                                 }
+                                 next if ($bighash{'randomout_'.$id} && !$env{'request.role.adv'});
+                                 next unless ($bighash{'encrypted_'.$id} eq $env{'request.enc'});
                                  if ($checkforblock) {
                                      my @blockers = &has_comm_blocking('bre',$poss_syval,$file);
-                                     unless (@blockers > 0) {
+                                     if (@blockers > 0) {
+                                         $syval = '';
+                                     } else {
                                          $syval = $poss_syval;
                                          $realpossible++;
                                      }
@@ -13401,6 +13442,11 @@ sub symbread {
                                      $syval = $poss_syval;
                                      $realpossible++;
                                  }
+                                 if ($syval) {
+                                     if (ref($possibles) eq 'HASH') {
+                                         $possibles->{$syval} = 1;
+                                     }
+                                 }
                              }
 			 }
                      }
@@ -13413,10 +13459,15 @@ sub symbread {
            }
         }
         if ($syval) {
-	    return $env{$cache_str}=$syval;
+            if ($nocache) {
+                return $syval;
+            } else {
+	        return $env{$cache_str}=$syval;
+            }
         }
     }
     &appenv({'request.ambiguous' => $thisfn});
+    return '' if ($nocache);
     return $env{$cache_str}='';
 }