--- loncom/lonnet/perl/lonnet.pm	2020/05/27 17:11:31	1.1172.2.124
+++ loncom/lonnet/perl/lonnet.pm	2020/10/23 21:52:59	1.1172.2.130
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1172.2.124 2020/05/27 17:11:31 raeburn Exp $
+# $Id: lonnet.pm,v 1.1172.2.130 2020/10/23 21:52:59 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -1082,6 +1082,21 @@ sub check_for_balancer_cookie {
     return ($otherserver,$cookie);
 }
 
+sub updatebalcookie {
+    my ($cookie,$balancer,$lastentry)=@_;
+    if ($cookie =~ /^($match_domain)\_($match_username)\_[a-f0-9]{32}$/) {
+        my ($udom,$uname) = ($1,$2);
+        my $uprimary_id = &domain($udom,'primary');
+        my $uintdom = &internet_dom($uprimary_id);
+        my $intdom = &internet_dom($balancer);
+        my $serverhomedom = &host_domain($balancer);
+        if (($uintdom ne '') && ($uintdom eq $intdom)) {
+            return &reply('updatebalcookie:'.&escape($cookie).':'.&escape($lastentry),$balancer);
+        }
+    }
+    return;
+}
+
 sub delbalcookie {
     my ($cookie,$balancer) =@_;
     if ($cookie =~ /^($match_domain)\_($match_username)\_[a-f0-9]{32}$/) {
@@ -1091,7 +1106,7 @@ sub delbalcookie {
         my $intdom = &internet_dom($balancer);
         my $serverhomedom = &host_domain($balancer);
         if (($uintdom ne '') && ($uintdom eq $intdom)) {
-            return &reply("delbalcookie:$cookie",$balancer);
+            return &reply('delbalcookie:'.&escape($cookie),$balancer);
         }
     }
 }
@@ -1578,7 +1593,7 @@ sub check_loadbalancing {
     if ($domneedscache) {
         &do_cache_new('loadbalancing',$domneedscache,$is_balancer,$cachetime);
     }
-    if ($is_balancer) {
+    if (($is_balancer) && ($caller ne 'switchserver')) {
         my $lowest_load = 30000;
         if (ref($offloadto) eq 'HASH') {
             if (ref($offloadto->{'primary'}) eq 'ARRAY') {
@@ -1618,9 +1633,9 @@ sub check_loadbalancing {
                 }
             }
         }
-        unless ($homeintdom) {
-            undef($setcookie);
-        }
+    }
+    if (($is_balancer) && (!$homeintdom)) {
+        undef($setcookie);
     }
     return ($is_balancer,$otherserver,$setcookie);
 }
@@ -3085,12 +3100,7 @@ sub unsubscribe {
     } elsif (grep { $_ eq $home } &current_machine_ids()) {
         $answer = 'home';
     } else {
-        my $defdom = $perlvar{'lonDefDomain'};
-        if (&will_trust('content',$defdom,$udom)) {
-            $answer = reply("unsub:$fname",$home);
-        } else {
-            $answer = 'untrusted';
-        }
+        $answer = reply("unsub:$fname",$home);
     }
     return $answer;
 }
@@ -7789,7 +7799,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;
@@ -8014,7 +8024,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 {
@@ -8034,7 +8044,7 @@ sub allowed {
                         if ($noblockcheck) {
                             $thisallowed='F';
                         } else {
-                            my @blockers = &has_comm_blocking($priv,$symb,$refuri);
+                            my @blockers = &has_comm_blocking($priv,'',$refuri,'',1);
                             if (@blockers > 0) {
                                 $thisallowed = 'B';
                             } else {
@@ -8107,7 +8117,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 {
@@ -8120,7 +8130,7 @@ sub allowed {
                $checkreferer=0;
            }
        }
-       
+
        if ($checkreferer) {
 	  my $refuri=$env{'httpref.'.$orguri};
             unless ($refuri) {
@@ -8149,7 +8159,7 @@ sub allowed {
                       if ($noblockcheck) {
                           $thisallowed.=$value;
                       } else {
-                          my @blockers = &has_comm_blocking($priv,$symb,$refuri);
+                          my @blockers = &has_comm_blocking($priv,'',$refuri,'',1);
                           if (@blockers > 0) {
                               $thisallowed = 'B';
                           } else {
@@ -8235,7 +8245,7 @@ sub allowed {
 	   }
        }
     }
-   
+
 #
 # Rest of the restrictions depend on selected course
 #
@@ -8393,22 +8403,27 @@ sub constructaccess {
 #
 # User for whom data are being temporarily cached.
 my $cacheduser='';
+# Course for which data are being temporarily cached.
+my $cachedcid='';
 # Cached blockers for this user (a hash of blocking items).
 my %cachedblockers=();
 # When the data were last cached.
 my $cachedlast='';
 
 sub load_all_blockers {
-    my ($uname,$udom,$blocks)=@_;
+    my ($uname,$udom)=@_;
     if (($uname ne '') && ($udom ne '')) {
         if (($cacheduser eq $uname.':'.$udom) &&
+            ($cachedcid eq $env{'request.course.id'}) &&
             (abs($cachedlast-time)<5)) {
             return;
         }
     }
     $cachedlast=time;
     $cacheduser=$uname.':'.$udom;
-    %cachedblockers = &get_commblock_resources($blocks);
+    $cachedcid=$env{'request.course.id'};
+    %cachedblockers = &get_commblock_resources();
+    return;
 }
 
 sub get_comm_blocks {
@@ -8488,14 +8503,23 @@ sub get_commblock_resources {
                             if ($mapsymb) {
                                 if (ref($navmap)) {
                                     my $mapres = $navmap->getBySymb($mapsymb);
-                                    @to_test = $mapres->retrieveResources($mapres,undef,0,0,0,1);
-                                    foreach my $res (@to_test) {
-                                        my $symb = $res->symb();
-                                        next if ($symb eq $mapsymb);
-                                        if ($symb ne '') {
-                                            @interval=&EXT("resource.0.interval",$symb);
-                                            if ($interval[1] eq 'map') {
-                                                last;
+                                    if (ref($mapres)) {
+                                        my $first = $mapres->map_start();
+                                        my $finish = $mapres->map_finish();
+                                        my $it = $navmap->getIterator($first,$finish,undef,0,0);
+                                        if (ref($it)) {
+                                            my $res;
+                                            while ($res = $it->next(undef,1)) {
+                                                next unless (ref($res));
+                                                my $symb = $res->symb();
+                                                next if (($symb eq $mapsymb) || ($symb eq ''));
+                                                @interval=&EXT("resource.0.interval",$symb);
+                                                if ($interval[1] eq 'map') {
+                                                    if ($res->answerable()) {
+                                                        push(@to_test,$res);
+                                                        last;
+                                                    }
+                                                }
                                             }
                                         }
                                     }
@@ -8545,17 +8569,23 @@ sub get_commblock_resources {
 }
 
 sub has_comm_blocking {
-    my ($priv,$symb,$uri,$blocks) = @_;
+    my ($priv,$symb,$uri,$ignoresymbdb,$noenccheck,$blocked,$blocks) = @_;
     my @blockers;
     return unless ($env{'request.course.id'});
     return unless ($priv eq 'bre');
     return if ($env{'user.priv.'.$env{'request.role'}} =~/evb\&([^\:]*)/);
     return if ($env{'request.state'} eq 'construct');
-    &load_all_blockers($env{'user.name'},$env{'user.domain'},$blocks);
-    return unless (keys(%cachedblockers) > 0);
+    my %blockinfo;
+    if (ref($blocks) eq 'HASH') {
+        %blockinfo = &get_commblock_resources($blocks);
+    } else {
+        &load_all_blockers($env{'user.name'},$env{'user.domain'});
+        %blockinfo = %cachedblockers;
+    }
+    return unless (keys(%blockinfo) > 0);
     my (%possibles,@symbs);
     if (!$symb) {
-        $symb = &symbread($uri,1,1,1,\%possibles);
+        $symb = &symbread($uri,1,1,1,\%possibles,$ignoresymbdb,$noenccheck);
     }
     if ($symb) {
         @symbs = ($symb);
@@ -8566,34 +8596,38 @@ sub has_comm_blocking {
     foreach my $symb (@symbs) {
         last if ($noblock);
         my ($map,$resid,$resurl)=&decode_symb($symb);
-        foreach my $block (keys(%cachedblockers)) {
+        foreach my $block (keys(%blockinfo)) {
             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') {
-                if (ref($cachedblockers{$block}{'resources'}) eq 'HASH') {
-                    if ($cachedblockers{$block}{'resources'}{$symb}) {
+            if (ref($blockinfo{$block}) eq 'HASH') {
+                if (ref($blockinfo{$block}{'resources'}) eq 'HASH') {
+                    if ($blockinfo{$block}{'resources'}{$symb}) {
                         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);
+                if (ref($blockinfo{$block}{'maps'}) eq 'HASH') {
+                    if ($blockinfo{$block}{'maps'}{$map}) {
+                        unless (grep(/^\Q$block\E$/,@blockers)) {
+                            push(@blockers,$block);
+                        }
                     }
                 }
             }
         }
     }
-    return if ($noblock);
-    return @blockers;
+    unless ($noblock) {
+        return @blockers;
+    }
+    return;
 }
 }
 
@@ -12432,13 +12466,16 @@ sub deversion {
 # ------------------------------------------------------ Return symb list entry
 
 sub symbread {
-    my ($thisfn,$donotrecurse,$ignorecachednull,$checkforblock,$possibles)=@_;
+    my ($thisfn,$donotrecurse,$ignorecachednull,$checkforblock,$possibles,
+        $ignoresymbdb,$noenccheck)=@_;
     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};
+        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
@@ -12467,10 +12504,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 ($ignoresymbdb) {
+            if (tie(%hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db',
+                          &GDBM_READER(),0640)) {
+	        $syval=$hash{$targetfn};
+                untie(%hash);
+            }
+            if ($syval && $checkforblock) {
+                my @blockers = &has_comm_blocking('bre',$syval,$thisfn,$ignoresymbdb,$noenccheck);
+                if (@blockers) {
+                    $syval='';
+                }
+            }
         }
 # ---------------------------------------------------------- There was an entry
         if ($syval) {
@@ -12503,13 +12548,18 @@ 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},'',$noenccheck);
+                             if (@blockers) {
+                                 $syval = '';
+                                 untie(%bighash);
+                                 return $env{$cache_str}='';
+                             }
                          }
                      }
                  } elsif ((!$donotrecurse) || ($checkforblock) || (ref($possibles) eq 'HASH')) {
@@ -12528,12 +12578,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 (($noenccheck) || ($bighash{'encrypted_'.$id} eq $env{'request.enc'}));
                                  if ($checkforblock) {
-                                     my @blockers = &has_comm_blocking('bre',$poss_syval,$file);
-                                     unless (@blockers > 0) {
+                                     my @blockers = &has_comm_blocking('bre',$poss_syval,$file,'',$noenccheck);
+                                     if (@blockers > 0) {
+                                         $syval = '';
+                                     } else {
                                          $syval = $poss_syval;
                                          $realpossible++;
                                      }
@@ -12541,6 +12592,11 @@ sub symbread {
                                      $syval = $poss_syval;
                                      $realpossible++;
                                  }
+                                 if ($syval) {
+                                     if (ref($possibles) eq 'HASH') {
+                                         $possibles->{$syval} = 1;
+                                     }
+                                 }
                              }
 			 }
                      }