[LON-CAPA-cvs] cvs: loncom /auth blockedaccess.pm lonacc.pm /homework structuretags.pm /interface lonblockingstatus.pm loncommon.pm /lonnet/perl lonnet.pm
raeburn
raeburn at source.lon-capa.org
Sun Sep 27 20:10:29 EDT 2020
raeburn Mon Sep 28 00:10:29 2020 EDT
Modified files:
/loncom/auth lonacc.pm blockedaccess.pm
/loncom/interface lonblockingstatus.pm loncommon.pm
/loncom/homework structuretags.pm
/loncom/lonnet/perl lonnet.pm
Log:
- Bug 6518.
More comprehensive access to symb for a requested URL to determine when
access should be blocked and why, if content blocking in use.
-------------- next part --------------
Index: loncom/auth/lonacc.pm
diff -u loncom/auth/lonacc.pm:1.178 loncom/auth/lonacc.pm:1.179
--- loncom/auth/lonacc.pm:1.178 Mon Aug 10 03:22:54 2020
+++ loncom/auth/lonacc.pm Mon Sep 28 00:10:27 2020
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Cookie Based Access Handler
#
-# $Id: lonacc.pm,v 1.178 2020/08/10 03:22:54 raeburn Exp $
+# $Id: lonacc.pm,v 1.179 2020/09/28 00:10:27 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -452,6 +452,22 @@
return undef;
}
+sub needs_symb_check {
+ my ($requrl) = @_;
+ $requrl=~/\.(\w+)$/;
+ if ((&Apache::loncommon::fileembstyle($1) eq 'ssi') ||
+ ($requrl=~/^\/adm\/.*\/(aboutme|smppg|bulletinboard)(\?|$ )/x) ||
+ ($requrl=~/^\/adm\/wrapper\//) ||
+ ($requrl=~m|^/adm/coursedocs/showdoc/|) ||
+ ($requrl=~m|\.problem/smpedit$|) ||
+ ($requrl=~/^\/public\/.*\/syllabus$/) ||
+ ($requrl=~/^\/adm\/(viewclasslist|navmaps)$/) ||
+ ($requrl=~/^\/adm\/.*\/aboutme\/portfolio(\?|$)/)) {
+ return 1;
+ }
+ return;
+}
+
sub handler {
my $r = shift;
my $requrl=$r->uri;
@@ -621,7 +637,37 @@
my $now = time;
if ($requrl !~ m{^/(?:adm|public|(?:prt|zip)spool)/}
|| $requrl =~ /^\/adm\/.*\/(smppg|bulletinboard)(\?|$ )/x) {
- my $access=&Apache::lonnet::allowed('bre',$requrl);
+ my ($access,$poss_symb);
+ if (($env{'request.course.id'}) && (!$suppext) && (&needs_symb_check($requrl))) {
+ unless ($env{'form.symb'}) {
+ if ($r->args) {
+ &Apache::loncommon::get_unprocessed_cgi($r->args,['symb']);
+ }
+ }
+ if ($env{'form.symb'}) {
+ $poss_symb=&Apache::lonnet::symbclean($env{'form.symb'});
+ }
+ if ($poss_symb) {
+ my ($possmap,$resid,$url)=&Apache::lonnet::decode_symb($poss_symb);
+ $url = &Apache::lonnet::clutter($url);
+ unless (($url eq $requrl) && (&Apache::lonnet::is_on_map($possmap))) {
+ undef($poss_symb);
+ }
+ if ($poss_symb) {
+ if ((!$env{'request.role.adv'}) && ($env{'acc.randomout'}) &&
+ ($env{'acc.randomout'}=~/\&\Q$poss_symb\E\&/)) {
+ undef($poss_symb);
+ }
+ }
+ }
+ if ($poss_symb) {
+ $access=&Apache::lonnet::allowed('bre',$requrl,$poss_symb);
+ } else {
+ $access=&Apache::lonnet::allowed('bre',$requrl,'','','','',1);
+ }
+ } else {
+ $access=&Apache::lonnet::allowed('bre',$requrl);
+ }
if ($handle eq '') {
unless ($access eq 'F') {
if ($requrl =~ m{^/res/$match_domain/$match_username/}) {
@@ -638,6 +684,14 @@
return OK;
}
if ($access eq 'B') {
+ if ($poss_symb) {
+ if ($requrl=~m{^(/adm/.*/aboutme)/portfolio$}) {
+ $requrl = $1;
+ }
+ if (&Apache::lonnet::symbverify($poss_symb,$requrl)) {
+ $env{'request.symb'} = $poss_symb;
+ }
+ }
&Apache::blockedaccess::setup_handler($r);
return OK;
}
@@ -701,17 +755,8 @@
# ------------------------------------------------------------- This is allowed
if ($env{'request.course.id'}) {
&Apache::lonnet::countacc($requrl);
- $requrl=~/\.(\w+)$/;
my $query=$r->args;
- if ((&Apache::loncommon::fileembstyle($1) eq 'ssi') ||
- ($requrl=~/^\/adm\/.*\/(aboutme|smppg|bulletinboard)(\?|$ )/x) ||
- ($requrl=~/^\/adm\/wrapper\//) ||
- ($requrl=~m|^/adm/coursedocs/showdoc/|) ||
- ($requrl=~m|\.problem/smpedit$|) ||
- ($requrl=~/^\/public\/.*\/syllabus$/) ||
- ($requrl=~/^\/adm\/(viewclasslist|navmaps)$/) ||
- ($requrl=~/^\/adm\/.*\/aboutme\/portfolio(\?|$)/) ||
- ($requrl=~m{^/adm/$cdom/$cnum/\d+/ext\.tool$})) {
+ if (&needs_symb_check($requrl)) {
# ------------------------------------- This is serious stuff, get symb and log
my $symb;
if ($query) {
@@ -756,13 +801,38 @@
}
unless ($suppext) {
$symb=&Apache::lonnet::symbread($requrl);
- if (&Apache::lonnet::is_on_map($requrl) && $symb &&
- !&Apache::lonnet::symbverify($symb,$requrl)) {
- $r->log_reason('Invalid symb for '.$requrl.': '.$symb);
- $env{'user.error.msg'}=
- "$requrl:bre:1:1:Invalid Access";
- return HTTP_NOT_ACCEPTABLE;
- }
+ if (&Apache::lonnet::is_on_map($requrl) && $symb) {
+ my ($encstate,$invalidsymb);
+ unless (&Apache::lonnet::symbverify($symb,$requrl,\$encstate)) {
+ $invalidsymb = 1;
+ #
+ # If $env{'request.enc'} is true, but no encryption for $symb retrieved
+ # by original lonnet::symbread() call, call again to check for an instance
+ # of $requrl in the course which has encryption, and set that as the symb.
+ # If there is no such symb, or symbverify() fails for the new symb proceed
+ # to report invalid symb.
+ #
+ if ($env{'request.enc'} && !$encstate) {
+ my %possibles;
+ my $nocache = 1;
+ $symb = &Apache::lonnet::symbread($requrl,'','','',\%possibles,$nocache);
+ if ($symb) {
+ if (&Apache::lonnet::symbverify($symb,$requrl)) {
+ $invalidsymb = '';
+ }
+ } elsif (keys(%possibles) > 1) {
+ $r->internal_redirect('/adm/ambiguous');
+ return OK;
+ }
+ }
+ if ($invalidsymb) {
+ $r->log_reason('Invalid symb for '.$requrl.': '.$symb);
+ $env{'user.error.msg'}=
+ "$requrl:bre:1:1:Invalid Access";
+ return HTTP_NOT_ACCEPTABLE;
+ }
+ }
+ }
if ($symb) {
my ($map,$mid,$murl)=
&Apache::lonnet::decode_symb($symb);
@@ -780,6 +850,9 @@
}
}
$env{'request.symb'}=$symb;
+ if (($env{'request.symbread.cached.'}) && ($env{'request.symbread.cached.'} ne $symb)) {
+ $env{'request.symbread.cached.'} = $symb;
+ }
&Apache::lonnet::courseacclog($symb);
} else {
# ------------------------------------------------------- This is other content
Index: loncom/auth/blockedaccess.pm
diff -u loncom/auth/blockedaccess.pm:1.4 loncom/auth/blockedaccess.pm:1.5
--- loncom/auth/blockedaccess.pm:1.4 Sat Mar 31 23:10:47 2012
+++ loncom/auth/blockedaccess.pm Mon Sep 28 00:10:27 2020
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Information about blocking status for Portfolio files
#
-# $Id: blockedaccess.pm,v 1.4 2012/03/31 23:10:47 raeburn Exp $
+# $Id: blockedaccess.pm,v 1.5 2020/09/28 00:10:27 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -29,10 +29,11 @@
package Apache::blockedaccess;
use strict;
-use Apache::Constants qw(:common :http REDIRECT);
+use Apache::Constants qw(:common);
use Apache::lonnet;
use Apache::loncommon();
use Apache::lonlocal;
+use HTML::Entities();
sub handler {
my $r = shift;
@@ -41,7 +42,7 @@
return OK if $r->header_only;
&Apache::lonlocal::get_language_handle($r);
- my $origurl = $r->uri;
+ my $origurl = &Apache::lonnet::deversion($r->uri);
my ($blocked,$blocktext);
if (&Apache::lonnet::is_portfolio_url($origurl)) {
@@ -53,17 +54,33 @@
if ($env{'request.course.id'}) {
my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+ my $symb = $env{'request.symb'};
($blocked,$blocktext) =
- &Apache::loncommon::blocking_status('docs',$cnum,$cdom,$origurl);
+ &Apache::loncommon::blocking_status('docs',$cnum,$cdom,$origurl,1,$symb,'blockedaccess');
}
}
if ($blocked) {
$r->print(&Apache::loncommon::start_page('Access Temporarily Blocked'));
$r->print($blocktext);
+ } elsif ($origurl eq '/adm/blockedaccess') {
+ $r->print(&Apache::loncommon::start_page('Access Blocking Information'));
+ $r->print('<p class="LC_warning">'.&mt('Could not determine which page had access blocked.').'</p>');
} else {
- my $server = &Apache::lonnet::absolute_url();
- $r->header_out(Location => $server.$origurl);
- return REDIRECT;
+ $r->print(&Apache::loncommon::start_page('Access Blocking Information'));
+ my $link;
+ if ($origurl ne '') {
+ my $showurl = &Apache::lonenc::check_encrypt($origurl);
+ $link = &Apache::lonnet::absolute_url().$showurl;
+ if ($r->args ne '') {
+ $link .= '?'.$r->args;
+ }
+ }
+ $r->print('<p class="LC_info">'.
+ &mt('The page you are trying to reach was reported as having access blocked, but the reason is not available.').
+ '</p>');
+ if ($link) {
+ $r->print('<p><a href="'.&HTML::Entities::encode($link,'\'"<>&').'">'.&mt('Try again?').'</a></p>');
+ }
}
$r->print(&Apache::loncommon::end_page());
return OK;
Index: loncom/interface/lonblockingstatus.pm
diff -u loncom/interface/lonblockingstatus.pm:1.16 loncom/interface/lonblockingstatus.pm:1.17
--- loncom/interface/lonblockingstatus.pm:1.16 Tue Sep 22 12:19:15 2020
+++ loncom/interface/lonblockingstatus.pm Mon Sep 28 00:10:28 2020
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# displays the blocking status table
#
-# $Id: lonblockingstatus.pm,v 1.16 2020/09/22 12:19:15 raeburn Exp $
+# $Id: lonblockingstatus.pm,v 1.17 2020/09/28 00:10:28 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -43,11 +43,11 @@
$r->send_http_header;
return OK if $r->header_only;
- my (%activities,$activity,$origurl);
+ my (%activities,$activity,$origurl,$origsymb);
map { $activities{$_} = 1; } ('boards','chat','com','blogs','groups','port','printout','docs','grades','passwd','search');
# determine what kind of blocking we want details for
- &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['activity','url']);
+ &Apache::loncommon::get_unprocessed_cgi($ENV{'QUERY_STRING'},['activity','url','symb']);
$activity = $env{'form.activity'};
my $title = 'Communication Blocking Status Information';
@@ -58,15 +58,18 @@
$title = 'Blocking Status Information';
if ($activity eq 'docs') {
$origurl = $env{'form.url'};
+ $origsymb = $env{'form.symb'};
}
}
$r->print(&Apache::loncommon::start_page($title,undef,
{'only_body' => 1}));
if (($activity eq '') || (!$activities{$activity})) {
- $r->print('<span class="LC_error">'.&mt('Error: unknown activity type blocked').'</span>');
+ $r->print('<p class="LC_error">'.&mt('Error: unknown activity type blocked').'</p>');
+ } elsif (($activity eq 'docs') && ($origurl eq '') && ($origsymb eq '')) {
+ $r->print('<p class="LC_error">'.&mt('Error: could not determine what content was blocked from access').'</p>');
} else {
- $r->print(&blockpage($activity,$origurl));
+ $r->print(&blockpage($activity,$origurl,$origsymb));
}
$r->print(&Apache::loncommon::end_page());
@@ -76,7 +79,7 @@
sub blockpage {
- my ($activity,$origurl) = @_;
+ my ($activity,$origurl,$origsymb) = @_;
# in case of a portfolio block we need to determine the owner of the files
# we're trying to look at. This information is passed via query string.
@@ -103,14 +106,44 @@
}
}
-
# retrieve start/end of possible active blocking
- my %setters;
- my ($startblock,$endblock,$triggerblock) =
- &Apache::loncommon::blockcheck(\%setters,$activity,$uname,$udom,$origurl);
+ my (%setters,$startblock,$endblock,$triggerblock);
+
+ if ($activity eq 'docs') {
+ my ($cdom,$cnum);
+ if ($env{'request.course.id'}) {
+ $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+ $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+ }
+ my $cancheck;
+ if (($cdom ne '') && ($cnum ne '')) {
+ if ($origsymb =~ m{^uploaded/($match_domain)/($match_courseid)/}) {
+ my ($crsdom,$crsnum) = ($1,$2);
+ if (($cdom eq $crsdom) && ($cnum eq $crsnum)) {
+ $cancheck = 1;
+ }
+ } else {
+ $cancheck = 1;
+ }
+ }
+ if ($cancheck) {
+ ($startblock,$endblock,$triggerblock) =
+ &Apache::loncommon::blockcheck(\%setters,$activity,$cnum,$cdom,$origurl,1,$origsymb,'blockingstatus');
+ } else {
+ return '<p class="LC_info">'.&mt('Could not determine why access is blocked.').'</p>';
+ }
+ } else {
+ ($startblock,$endblock,$triggerblock) =
+ &Apache::loncommon::blockcheck(\%setters,$activity,$uname,$udom,$origurl,undef,$origsymb,'blockingstatus');
+ }
# nothing to do if there's no active blocking
- unless ($startblock && $endblock) { return ''; }
+ unless ($startblock && $endblock) {
+ if ($activity eq 'docs') {
+ return '<p class="LC_info">'.&mt('Content no longer blocked from access').'</p>';
+ }
+ return '<p class="LC_info">'.&mt('Access no longer blocked for this activity').'</p>';
+ }
# lookup $activity -> description
#possible activity #corresponding description
Index: loncom/interface/loncommon.pm
diff -u loncom/interface/loncommon.pm:1.1346 loncom/interface/loncommon.pm:1.1347
--- loncom/interface/loncommon.pm:1.1346 Tue Sep 22 12:19:15 2020
+++ loncom/interface/loncommon.pm Mon Sep 28 00:10:28 2020
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.1346 2020/09/22 12:19:15 raeburn Exp $
+# $Id: loncommon.pm,v 1.1347 2020/09/28 00:10:28 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -5148,13 +5148,13 @@
###############################################
sub blockcheck {
- my ($setters,$activity,$uname,$udom,$url,$is_course) = @_;
+ my ($setters,$activity,$uname,$udom,$url,$is_course,$symb,$caller) = @_;
if (defined($udom) && defined($uname)) {
# If uname and udom are for a course, check for blocks in the course.
if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) {
my ($startblock,$endblock,$triggerblock) =
- &get_blocks($setters,$activity,$udom,$uname,$url);
+ &get_blocks($setters,$activity,$udom,$uname,$url,$symb,$caller);
return ($startblock,$endblock,$triggerblock);
}
} else {
@@ -5283,7 +5283,7 @@
# of specified user, unless user has 'evb' privilege.
my ($start,$end,$trigger) =
- &get_blocks($setters,$activity,$cdom,$cnum,$url);
+ &get_blocks($setters,$activity,$cdom,$cnum,$url,$symb,$caller);
if (($start != 0) &&
(($startblock == 0) || ($startblock > $start))) {
$startblock = $start;
@@ -5303,7 +5303,7 @@
}
sub get_blocks {
- my ($setters,$activity,$cdom,$cnum,$url) = @_;
+ my ($setters,$activity,$cdom,$cnum,$url,$symb,$caller) = @_;
my $startblock = 0;
my $endblock = 0;
my $triggerblock = '';
@@ -5316,7 +5316,12 @@
my $now = time;
my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum);
if ($activity eq 'docs') {
- @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks);
+ my ($blocked,$nosymbcache);
+ if (($caller eq 'blockedaccess') || ($caller eq 'blockingstatus')) {
+ $blocked = 1;
+ $nosymbcache = 1;
+ }
+ @blockers = &Apache::lonnet::has_comm_blocking('bre',$symb,$url,$nosymbcache,$blocked,\%commblocks);
foreach my $block (@blockers) {
if ($block =~ /^firstaccess____(.+)$/) {
my $item = $1;
@@ -5444,12 +5449,12 @@
}
sub blocking_status {
- my ($activity,$uname,$udom,$url,$is_course) = @_;
+ my ($activity,$uname,$udom,$url,$is_course,$symb,$caller) = @_;
my %setters;
# check for active blocking
my ($startblock,$endblock,$triggerblock) =
- &blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course);
+ &blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course,$symb,$caller);
my $blocked = 0;
if ($startblock && $endblock) {
$blocked = 1;
@@ -5465,7 +5470,12 @@
$querystring .= "&udom=$udom" if ($udom =~ /^$match_domain$/);
$querystring .= "&uname=$uname" if ($uname =~ /^$match_username$/);
} elsif ($activity eq 'docs') {
- $querystring .= '&url='.&HTML::Entities::encode($url,'&"');
+ my $showurl = &Apache::lonenc::check_encrypt($url);
+ $querystring .= '&url='.&HTML::Entities::encode($showurl,'\'&"<>');
+ if ($symb) {
+ my $showsymb = &Apache::lonenc::check_encrypt($symb);
+ $querystring .= '&symb='.&HTML::Entities::encode($showsymb,'\'&"<>');
+ }
}
my $output .= <<'END_MYBLOCK';
Index: loncom/homework/structuretags.pm
diff -u loncom/homework/structuretags.pm:1.570 loncom/homework/structuretags.pm:1.571
--- loncom/homework/structuretags.pm:1.570 Thu Nov 7 02:58:37 2019
+++ loncom/homework/structuretags.pm Mon Sep 28 00:10:28 2020
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# definition of tags that give a structure to a document
#
-# $Id: structuretags.pm,v 1.570 2019/11/07 02:58:37 raeburn Exp $
+# $Id: structuretags.pm,v 1.571 2020/09/28 00:10:28 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -63,6 +63,7 @@
use Apache::lonenc();
use Apache::loncommon();
use Time::HiRes qw( gettimeofday tv_interval );
+use HTML::Entities();
use lib '/home/httpd/lib/perl/';
use LONCAPA;
@@ -1646,9 +1647,11 @@
my $uri = &Apache::lonenc::check_encrypt($env{'request.uri'});
my $buttontext = &mt('Show Resource');
my $timertext = &mt('Start Timer?');
+ my $shownsymb = &HTML::Entities::encode(&Apache::lonenc::check_encrypt($symb),'\'"<>&');
$result .= (<<ENDCHECKOUT);
<form name="markaccess" method="post" action="$uri">
<input type="hidden" name="markaccess" value="yes" />
+<input type="hidden" name="symb" value="$shownsymb" />
<input type="button" name="accessbutton" value="$buttontext" onclick="javascript:if (confirm('$timertext')) { document.markaccess.submit(); }" />
</form>
ENDCHECKOUT
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1423 loncom/lonnet/perl/lonnet.pm:1.1424
--- loncom/lonnet/perl/lonnet.pm:1.1423 Wed Jul 1 20:08:58 2020
+++ loncom/lonnet/perl/lonnet.pm Mon Sep 28 00:10:29 2020
@@ -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 @@
# ------------------------------------------------- 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 @@
} 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 @@
} 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 @@
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 @@
$checkreferer=0;
}
}
-
+
if ($checkreferer) {
my $refuri=$env{'httpref.'.$orguri};
unless ($refuri) {
@@ -8408,7 +8408,7 @@
} 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 @@
}
}
}
-
+
#
# Rest of the restrictions depend on selected course
#
@@ -8663,6 +8663,10 @@
#
# 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 @@
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 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 @@
return unless (keys(%cachedblockers) > 0);
my (%possibles, at 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 @@
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 @@
}
}
}
- }
- if (ref($cachedblockers{$block}{'maps'}) eq 'HASH') {
- if ($cachedblockers{$block}{'maps'}{$map}) {
- unless (grep(/^\Q$block\E$/, at blockers)) {
- push(@blockers,$block);
+ if (ref($cachedblockers{$block}{'maps'}) eq 'HASH') {
+ if ($cachedblockers{$block}{'maps'}{$map}) {
+ unless (grep(/^\Q$block\E$/, at blockers)) {
+ push(@blockers,$block);
+ }
}
}
}
}
}
- return if ($noblock);
- return @blockers;
+ unless ($noblock) {
+ return @blockers;
+ }
+ return;
}
}
@@ -13292,19 +13309,26 @@
# ------------------------------------------------------ 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 @@
# 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 @@
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 @@
$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 @@
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 @@
$syval = $poss_syval;
$realpossible++;
}
+ if ($syval) {
+ if (ref($possibles) eq 'HASH') {
+ $possibles->{$syval} = 1;
+ }
+ }
}
}
}
@@ -13413,10 +13459,15 @@
}
}
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}='';
}
More information about the LON-CAPA-cvs
mailing list