[LON-CAPA-cvs] cvs: loncom /auth lonacc.pm /interface lonexttool.pm /lonnet/perl lonnet.pm
raeburn
raeburn at source.lon-capa.org
Tue Oct 6 13:26:15 EDT 2020
raeburn Tue Oct 6 17:26:15 2020 EDT
Modified files:
/loncom/interface lonexttool.pm
/loncom/auth lonacc.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/interface/lonexttool.pm
diff -u loncom/interface/lonexttool.pm:1.20 loncom/interface/lonexttool.pm:1.20.2.1
--- loncom/interface/lonexttool.pm:1.20 Tue Aug 14 18:20:17 2018
+++ loncom/interface/lonexttool.pm Thu Apr 9 21:11:36 2020
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# Launch External Tool Provider (LTI)
#
-# $Id: lonexttool.pm,v 1.20 2018/08/14 18:20:17 raeburn Exp $
+# $Id: lonexttool.pm,v 1.20.2.1 2020/04/09 21:11:36 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -49,10 +49,6 @@
use Apache::lonlocal;
use Apache::lonnet;
use Apache::loncommon;
-use Apache::londatecheck;
-use Apache::lonipcheck;
-use Apache::lonhomework;
-use Apache::structuretags;
use LONCAPA::ltiutils;
sub handler {
@@ -110,7 +106,7 @@
width => $toolsettings{'width'},
height => $toolsettings{'height'},
};
- foreach my $item (qw(crslabel crstitle crsappend gradable)) {
+ foreach my $item (qw(crslabel crstitle crsappend)) {
$toolhash{$item} = $toolsettings{$item};
}
$is_tool = 1;
@@ -134,37 +130,16 @@
my $title = &Apache::lonnet::gettitle($symb);
$r->print(&mt('External Tool: [_1]','\textit{'.$title.'}').'\\\\');
}
- if ($toolhash{'gradable'}) {
- $Apache::lonhomework::browse = &Apache::lonnet::allowed('bre',$r->uri);
- if ($env{'form.markaccess'}) {
- my @interval=&Apache::lonnet::EXT('resource.0.interval',$symb);
- my ($timelimit) = split(/_/,$interval[0]);
- &Apache::lonnet::set_first_access($interval[1],$timelimit);
- } elsif ($symb && $env{'form.LC_interval_done'} eq 'true') {
- # Set the event timer to zero if the "done button" was clicked. The button is
- # part of the doneButton form created in lonmenu.pm
- ($donebuttonresult,$donemsg) = &Apache::lonhomework::zero_timer($symb);
- undef($env{'form.LC_interval_done'});
- undef($env{'form.LC_interval_done_proctorpass'});
- }
- ($status,$msg) = &gradabletool_access_check($target);
- undef($Apache::lonhomework::browse);
- if ($status eq 'SHOW_ANSWER') {
- $r->print(&display_score($target));
- if ($target eq 'tex') {
- $r->print('\end{document}');
- }
- return OK;
- } elsif ($status ne 'CAN_ANSWER') {
- if ($target eq 'tex') {
- $r->print('\end{document}');
- } else {
- $r->print($msg);
- }
- return OK;
+ my ($status,$open,$close,$msg)=&Apache::londatecheck::content_date_check();
+ if ($status ne 'OPEN') {
+ if ($target eq 'tex') {
+ $r->print(&mt('Not open to be viewed').'\end{document}');
+ } else {
+ $r->print($msg);
}
+ return OK;
} else {
- my ($status,$open,$close,$msg)=&Apache::londatecheck::content_date_check();
+ ($status,$msg)=&Apache::lonipcheck::ip_access_check();
if ($status ne 'OPEN') {
if ($target eq 'tex') {
$r->print(&mt('Not open to be viewed').'\end{document}');
@@ -172,16 +147,6 @@
$r->print($msg);
}
return OK;
- } else {
- ($status,$msg)=&Apache::lonipcheck::ip_access_check();
- if ($status ne 'OPEN') {
- if ($target eq 'tex') {
- $r->print(&mt('Not open to be viewed').'\end{document}');
- } else {
- $r->print($msg);
- }
- return OK;
- }
}
}
my $launchok = 1;
@@ -189,20 +154,6 @@
$r->print('\end{document}');
} else {
my $now = time;
- if ($toolhash{'passback'}) {
- if (&LONCAPA::ltiutils::set_service_secret($cdom,$cnum,$marker,'grade',$now,
- \%toolsettings,\%toolhash) eq 'ok') {
- $toolhash{'gradesecret'} = $toolsettings{'gradesecret'};
- } else {
- undef($launchok);
- }
- }
- if ($toolhash{'roster'}) {
- if (&LONCAPA::ltiutils::set_service_secret($cdom,$cnum,$marker,'roster',$now,
- \%toolsettings,\%toolhash) eq 'ok') {
- $toolhash{'rostersecret'} = $toolsettings{'rostersecret'};
- }
- }
my $submittext = &mt('Launch [_1]',$toolhash{'title'});
if (($toolhash{'key'} ne '') && ($toolhash{'secret'} ne '') &&
($toolhash{'url'} ne '') && ($launchok)) {
@@ -223,15 +174,10 @@
sub lti_params {
my ($r,$cnum,$cdom,$idx,$submittext,$toolsref) = @_;
my ($version,$context_type,$msgtype,$toolname,$passback,$roster,$locale,
- $crslabel,$crstitle,$gradesecret,$rostersecret,%fields,%rolesmap,
- %display,%custom, at userlangs,$incdom);
+ $crslabel,$crstitle,%fields,%rolesmap,%display,%custom, at userlangs,$incdom);
if (ref($toolsref) eq 'HASH') {
$version = $toolsref->{'version'};
$toolname = $toolsref->{'title'};
- $passback = $toolsref->{'passback'};
- $gradesecret = $toolsref->{'gradesecret'};
- $roster = $toolsref->{'roster'};
- $rostersecret = $toolsref->{'rostersecret'};
$msgtype = $toolsref->{'messagetype'};
$incdom = $toolsref->{'incdom'};
if (ref($toolsref->{'fields'}) eq 'HASH') {
@@ -340,43 +286,6 @@
unless ($crsprotocol eq 'https') {
$crsprotocol = 'http';
}
- if (($passback) || ($roster)) {
- my (%currdigest,%digesthash);
- if (@possdigest) {
- %currdigest = &Apache::lonnet::get('exttools',\@possdigest,
- $cdom,$cnum);
- }
- if ($passback) {
- $ltiparams{'lis_outcome_service_url'} = $crsprotocol.'://'.$crshostname.'/adm/service/passback';
- $ltiparams{'ext_ims_lis_basic_outcome_url'} = $ltiparams{'lis_outcome_service_url'};
- if ($gradesecret) {
- my $uniqid = $digest_symb.':::'.$digest_user.':::'.$env{'request.course.id'};
- $ltiparams{'lis_result_sourcedid'} = &LONCAPA::ltiutils::get_service_id($gradesecret,$uniqid);
- }
- }
- if ($roster) {
- if (&Apache::lonnet::allowed('opa',$env{'request.course.id'})) {
- $ltiparams{'ext_ims_lis_memberships_url'} = $crsprotocol.'://'.$crshostname.'/adm/service/roster';
- if ($rostersecret) {
- my $uniqid = $digest_symb.':::'.$env{'request.course.id'};
- $ltiparams{'ext_ims_lis_memberships_id'} = &LONCAPA::ltiutils::get_service_id($rostersecret,$uniqid);
- }
- }
- }
- if (($digest_symb) && ($gradesecret || $rostersecret)) {
- unless ((exists($currdigest{$digest_symb})) && ($currdigest{$digest_symb} eq $symb)) {
- $digesthash{$digest_symb} = $symb;
- }
- }
- if (($passback) && ($gradesecret)) {
- unless ((exists($currdigest{$digest_user})) && ($currdigest{$digest_user} eq $uname.':'.$udom)) {
- $digesthash{$digest_user} = $uname.':'.$udom;
- }
- }
- if (keys(%digesthash)) {
- &Apache::lonnet::put('exttools',\%digesthash,$cdom,$cnum);
- }
- }
}
if ($display{'target'}) {
$ltiparams{'launch_presentation_document_target'} = $display{'target'};
@@ -469,97 +378,4 @@
return $form;
}
-sub gradabletool_access_check {
- my ($target) = @_;
- my ($result,$resource_due);
- my $status;
- my ($symb,$courseid,$udom,$uname) = &Apache::lonnet::whichuser();
- my @targets;
- if ($target) {
- @targets = ($target);
- } elsif (defined($env{'form.submitted'}) && defined($env{'form.validate'})) {
- @targets = ('grade','web');
- } else {
- @targets = ('web');
- }
- foreach my $target (@targets) {
- &Apache::structuretags::initialize_storage($symb);
- &Apache::lonhomework::set_show_problem_status(&Apache::lonnet::EXT('resource.0.problemstatus'));
- my ($accessmsg,$slot_name,$slot,$ipused);
- ($status,$accessmsg,$slot_name,$slot,$ipused) =
- &Apache::lonhomework::check_slot_access('0','tool',$symb);
- if (( $status eq 'CLOSED' ) ||
- ( $status eq 'UNCHECKEDOUT') ||
- ( $status eq 'NOT_YET_VIEWED') ||
- ( $status eq 'BANNED') ||
- ( $status eq 'UNAVAILABLE') ||
- ( $status eq 'NOT_IN_A_SLOT') ||
- ( $status eq 'NOTRESERVABLE') ||
- ( $status eq 'RESERVABLE') ||
- ( $status eq 'RESERVABLE_LATER') ||
- ( $status eq 'INVALID_ACCESS') ||
- ( $status eq 'NEED_DIFFERENT_IP') ||
- ( $status eq 'WAITING_FOR_GRADE')) {
- $result = &Apache::structuretags::access_status_msg('tool',$status,$symb,
- $target,$ipused,$accessmsg);
- } elsif ($status eq 'NEEDS_CHECKIN') {
- $result = &Apache::structuretags::checkin_prompt($target,$slot_name,$slot,'tool');
- } elsif ($target eq 'web') {
- if ($status eq 'CAN_ANSWER') {
- $resource_due = &Apache::lonhomework::due_date(0, $env{'request.symb'});
- if ($slot_name ne '') {
- $resource_due = &Apache::structuretags::selfcheckin_resource($resource_due,
- $slot_name,$slot,
- $env{'request.symb'});
- }
- }
- }
- if (keys(%Apache::lonhomework::results)) {
- &Apache::structuretags::finalize_storage();
- }
- }
- return ($status,$result,$resource_due);
-}
-
-sub display_score {
- my ($target) = @_;
- my $weight = &Apache::lonnet::EXT('resource.0.weight');
- if ((!defined($weight)) || ($weight eq '')) { $weight=1; }
- my $awarded = $Apache::lonhomework::history{'resource.0.awarded'};
- if (!defined($awarded)) { $awarded=0; }
- my $display='';
- if ($target eq 'tex') {
- $display = '\\\\';
- }
- if (!defined($awarded)) {
- $display .= &mt('[_1] possible points.',$weight);
- } else {
- my $points = $awarded*$weight;
- my $result = sprintf('%.2f',$points);
- $display .= &mt('You have [_1] out of [quant,_2,possible point]',
- $result,$weight);
- }
- my $comment = $Apache::lonhomework::history{'resource.0.comment'};
- if (!defined($comment) || $comment!~/\w/) {
- $comment='';
- } else {
- if ($target eq 'tex') {
- $comment = '\\\\'.$comment;
- } else {
- $comment='<br /><table><tr><td bgcolor="#FFFFDD">'.$comment.'</td></tr></table>';
- }
- }
- my $gradeinfo = $Apache::lonhomework::history{'resource.0.gradeinfo'};
- if (!defined($gradeinfo) || $gradeinfo!~/\w/) {
- $gradeinfo='';
- } else {
- if ($target eq 'tex') {
- $gradeinfo = '\\\\'.$gradeinfo;
- } else {
- $gradeinfo='<br /><table><tr><td bgcolor="#DDDDFF"><font size="+2">'.$gradeinfo.'</font></td></tr></table>';
- }
- }
- return $display.$comment.$gradeinfo;
-}
-
1;
Index: loncom/auth/lonacc.pm
diff -u loncom/auth/lonacc.pm:1.181 loncom/auth/lonacc.pm:1.182
--- loncom/auth/lonacc.pm:1.181 Thu Oct 1 10:16:33 2020
+++ loncom/auth/lonacc.pm Tue Oct 6 17:26:15 2020
@@ -1,7 +1,7 @@
# The LearningOnline Network
# Cookie Based Access Handler
#
-# $Id: lonacc.pm,v 1.181 2020/10/01 10:16:33 raeburn Exp $
+# $Id: lonacc.pm,v 1.182 2020/10/06 17:26:15 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -633,7 +633,8 @@
($requrl=~m|\.problem/smpedit$|) ||
($requrl=~/^\/public\/.*\/syllabus$/) ||
($requrl=~/^\/adm\/(viewclasslist|navmaps)$/) ||
- ($requrl=~/^\/adm\/.*\/aboutme\/portfolio(\?|$)/)) {
+ ($requrl=~/^\/adm\/.*\/aboutme\/portfolio(\?|$)/) ||
+ ($requrl=~m{^/adm/$cdom/$cnum/\d+/ext\.tool$})) {
$check_symb = 1;
}
}
@@ -811,19 +812,29 @@
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'} inconsistent with encryption expected for $symb
+ # retrieved by lonnet::symbread(), call again to check for an instance of
+ # $requrl in the course for which expected encryption matches request.enc.
+ # If symb for different instance passes lonnet::symbverify(), use that as
+ # the symb for $requrl and call &Apache::lonnet::allowed() for that symb.
+ # Report invalid symb if there is no other symb. Redirect to /adm/ambiguous
+ # if multiple possible symbs consistent with request.enc available for $requrl.
#
- if ($env{'request.enc'} && !$encstate) {
+ if (($env{'request.enc'} && !$encstate) || (!$env{'request.enc'} && $encstate)) {
my %possibles;
my $nocache = 1;
+ my $oldsymb = $symb;
$symb = &Apache::lonnet::symbread($requrl,'','','',\%possibles,$nocache);
- if ($symb) {
+ if (($symb) && ($symb ne $oldsymb)) {
if (&Apache::lonnet::symbverify($symb,$requrl)) {
- $invalidsymb = '';
+ my $access=&Apache::lonnet::allowed('bre',$requrl,$symb);
+ if ($access eq 'B') {
+ $env{'request.symb'} = $symb;
+ &Apache::blockedaccess::setup_handler($r);
+ return OK;
+ } elsif (($access eq '2') || ($access eq 'F')) {
+ $invalidsymb = '';
+ }
}
} elsif (keys(%possibles) > 1) {
$r->internal_redirect('/adm/ambiguous');
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.1426 loncom/lonnet/perl/lonnet.pm:1.1427
--- loncom/lonnet/perl/lonnet.pm:1.1426 Thu Oct 1 10:16:34 2020
+++ loncom/lonnet/perl/lonnet.pm Tue Oct 6 17:26:15 2020
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.1426 2020/10/01 10:16:34 raeburn Exp $
+# $Id: lonnet.pm,v 1.1427 2020/10/06 17:26:15 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -8665,32 +8665,24 @@
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;
}
@@ -8829,17 +8821,23 @@
}
sub has_comm_blocking {
- my ($priv,$symb,$uri,$nosymbcache,$noenccheck,$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, at symbs);
if (!$symb) {
- $symb = &symbread($uri,1,1,1,\%possibles,$nosymbcache,$noenccheck);
+ $symb = &symbread($uri,1,1,1,\%possibles,$ignoresymbdb,$noenccheck);
}
if ($symb) {
@symbs = ($symb);
@@ -8850,7 +8848,7 @@
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 +8858,16 @@
}
}
}
- 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$/, at 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$/, at blockers)) {
push(@blockers,$block);
}
@@ -13310,9 +13308,9 @@
sub symbread {
my ($thisfn,$donotrecurse,$ignorecachednull,$checkforblock,$possibles,
- $nocache,$noenccheck)=@_;
+ $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 +13322,7 @@
# 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 +13330,7 @@
# 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 +13345,14 @@
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,$noenccheck);
+ if ($syval && $checkforblock) {
+ my @blockers = &has_comm_blocking('bre',$syval,$thisfn,$ignoresymbdb,$noenccheck);
if (@blockers) {
$syval='';
}
@@ -13409,7 +13399,6 @@
if (@blockers) {
$syval = '';
untie(%bighash);
- return '' if ($nocache);
return $env{$cache_str}='';
}
}
@@ -13461,15 +13450,10 @@
}
}
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}='';
}
More information about the LON-CAPA-cvs
mailing list