--- loncom/lonnet/perl/lonnet.pm 2020/09/28 00:10:29 1.1424
+++ loncom/lonnet/perl/lonnet.pm 2020/10/22 19:23:23 1.1431
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.1424 2020/09/28 00:10:29 raeburn Exp $
+# $Id: lonnet.pm,v 1.1431 2020/10/22 19:23:23 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -1150,6 +1150,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}$/) {
@@ -1159,7 +1174,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);
}
}
}
@@ -1646,7 +1661,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') {
@@ -1686,9 +1701,9 @@ sub check_loadbalancing {
}
}
}
- unless ($homeintdom) {
- undef($setcookie);
- }
+ }
+ if (($is_balancer) && (!$homeintdom)) {
+ undef($setcookie);
}
return ($is_balancer,$otherserver,$setcookie,$offloadto,$dom_balancers);
}
@@ -8290,7 +8305,7 @@ sub allowed {
} elsif ($noblockcheck) {
$thisallowed='F';
} else {
- my @blockers = &has_comm_blocking($priv,$symb,$refuri,$ignorecache);
+ my @blockers = &has_comm_blocking($priv,'',$refuri,'',1);
if (@blockers > 0) {
$thisallowed = 'B';
} else {
@@ -8408,7 +8423,7 @@ sub allowed {
} elsif ($noblockcheck) {
$thisallowed.=$value;
} else {
- my @blockers = &has_comm_blocking($priv,'',$refuri,$ignorecache);
+ my @blockers = &has_comm_blocking($priv,'',$refuri,'',1);
if (@blockers > 0) {
$thisallowed = 'B';
} else {
@@ -8665,32 +8680,24 @@ sub constructaccess {
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.
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) &&
- (((ref($blocks) eq 'HASH') &&
- ($cachedblocks eq join(',',sort(keys(%{$blocks}))))) ||
- (!ref($blocks) && $cachedblocks eq ''))) {
+ (abs($cachedlast-time)<5)) {
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})));
- }
+ %cachedblockers = &get_commblock_resources();
return;
}
@@ -8771,14 +8778,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;
+ }
+ }
}
}
}
@@ -8829,17 +8845,23 @@ sub get_commblock_resources {
}
sub has_comm_blocking {
- my ($priv,$symb,$uri,$nosymbcache,$blocked,$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,'',\%possibles,$nosymbcache);
+ $symb = &symbread($uri,1,1,1,\%possibles,$ignoresymbdb,$noenccheck);
}
if ($symb) {
@symbs = ($symb);
@@ -8850,7 +8872,7 @@ 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;
unless ($blocked) {
@@ -8860,16 +8882,16 @@ sub has_comm_blocking {
}
}
}
- 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}) {
+ if (ref($blockinfo{$block}{'maps'}) eq 'HASH') {
+ if ($blockinfo{$block}{'maps'}{$map}) {
unless (grep(/^\Q$block\E$/,@blockers)) {
push(@blockers,$block);
}
@@ -13310,9 +13332,9 @@ sub deversion {
sub symbread {
my ($thisfn,$donotrecurse,$ignorecachednull,$checkforblock,$possibles,
- $nocache)=@_;
+ $ignoresymbdb,$noenccheck)=@_;
my $cache_str='request.symbread.cached.'.$thisfn;
- if (defined($env{$cache_str}) && !$nocache) {
+ if (defined($env{$cache_str})) {
unless (ref($possibles) eq 'HASH') {
if ($ignorecachednull) {
return $env{$cache_str} unless ($env{$cache_str} eq '');
@@ -13324,11 +13346,7 @@ sub symbread {
# no filename provided? try from environment
unless ($thisfn) {
if ($env{'request.symb'}) {
- if ($nocache) {
- return &symbclean($env{'request.symb'});
- } else {
- return $env{$cache_str}=&symbclean($env{'request.symb'});
- }
+ return $env{$cache_str}=&symbclean($env{'request.symb'});
}
$thisfn=$env{'request.filename'};
}
@@ -13336,11 +13354,7 @@ sub symbread {
# is that filename actually a symb? Verify, clean, and return
if ($thisfn=~/\_\_\_\d+\_\_\_(.*)$/) {
if (&symbverify($thisfn,$1)) {
- if ($nocache) {
- return &symbclean($thisfn);
- } else {
- return $env{$cache_str}=&symbclean($thisfn);
- }
+ return $env{$cache_str}=&symbclean($thisfn);
}
}
$thisfn=declutter($thisfn);
@@ -13355,14 +13369,14 @@ sub symbread {
if ($targetfn =~ m|^adm/wrapper/(ext/.*)|) {
$targetfn=$1;
}
- unless ($nocache) {
+ unless ($ignoresymbdb) {
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 ($syval && $checkforblock) {
+ my @blockers = &has_comm_blocking('bre',$syval,$thisfn,$ignoresymbdb,$noenccheck);
if (@blockers) {
$syval='';
}
@@ -13405,10 +13419,11 @@ sub symbread {
}
if ($checkforblock) {
unless ($bighash{'randomout_'.$ids} || $env{'request.role.adv'}) {
- my @blockers = &has_comm_blocking('bre',$syval,$bighash{'src_'.$ids});
+ my @blockers = &has_comm_blocking('bre',$syval,$bighash{'src_'.$ids},'',$noenccheck);
if (@blockers) {
$syval = '';
- return;
+ untie(%bighash);
+ return $env{$cache_str}='';
}
}
}
@@ -13429,9 +13444,9 @@ sub symbread {
my $poss_syval=&encode_symb($bighash{'map_id_'.$mapid},
$resid,$thisfn);
next if ($bighash{'randomout_'.$id} && !$env{'request.role.adv'});
- next unless ($bighash{'encrypted_'.$id} eq $env{'request.enc'});
+ next unless (($noenccheck) || ($bighash{'encrypted_'.$id} eq $env{'request.enc'}));
if ($checkforblock) {
- my @blockers = &has_comm_blocking('bre',$poss_syval,$file);
+ my @blockers = &has_comm_blocking('bre',$poss_syval,$file,'',$noenccheck);
if (@blockers > 0) {
$syval = '';
} else {
@@ -13459,15 +13474,10 @@ sub symbread {
}
}
if ($syval) {
- if ($nocache) {
- return $syval;
- } else {
- return $env{$cache_str}=$syval;
- }
+ return $env{$cache_str}=$syval;
}
}
&appenv({'request.ambiguous' => $thisfn});
- return '' if ($nocache);
return $env{$cache_str}='';
}