--- loncom/lonnet/perl/lonnet.pm 2020/09/28 00:10:29 1.1424 +++ loncom/lonnet/perl/lonnet.pm 2020/10/15 19:17:40 1.1429 @@ -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.1429 2020/10/15 19:17:40 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -8290,7 +8290,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 +8408,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 +8665,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 +8763,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 +8830,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 +8857,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 +8867,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 +13317,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 +13331,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 +13339,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 +13354,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 +13404,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 +13429,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 +13459,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}=''; }