--- loncom/lonnet/perl/lonnet.pm 2015/04/01 23:43:55 1.1172.2.62 +++ loncom/lonnet/perl/lonnet.pm 2015/04/19 22:42:56 1.1172.2.65 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1172.2.62 2015/04/01 23:43:55 raeburn Exp $ +# $Id: lonnet.pm,v 1.1172.2.65 2015/04/19 22:42:56 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -4953,7 +4953,7 @@ sub tmprestore { # ----------------------------------------------------------------------- Store sub store { - my ($storehash,$symb,$namespace,$domain,$stuname) = @_; + my ($storehash,$symb,$namespace,$domain,$stuname,$laststore) = @_; my $home=''; if ($stuname) { $home=&homeserver($stuname,$domain); } @@ -4983,13 +4983,13 @@ sub store { } $namevalue=~s/\&$//; &courselog($symb.':'.$stuname.':'.$domain.':STORE:'.$namevalue); - return reply("store:$domain:$stuname:$namespace:$symb:$namevalue","$home"); + return reply("store:$domain:$stuname:$namespace:$symb:$namevalue:$laststore","$home"); } # -------------------------------------------------------------- Critical Store sub cstore { - my ($storehash,$symb,$namespace,$domain,$stuname) = @_; + my ($storehash,$symb,$namespace,$domain,$stuname,$laststore) = @_; my $home=''; if ($stuname) { $home=&homeserver($stuname,$domain); } @@ -5020,7 +5020,7 @@ sub cstore { $namevalue=~s/\&$//; &courselog($symb.':'.$stuname.':'.$domain.':CSTORE:'.$namevalue); return critical - ("store:$domain:$stuname:$namespace:$symb:$namevalue","$home"); + ("store:$domain:$stuname:$namespace:$symb:$namevalue:$laststore","$home"); } # --------------------------------------------------------------------- Restore @@ -6699,7 +6699,7 @@ sub customaccess { # ------------------------------------------------- Check for a user privilege sub allowed { - my ($priv,$uri,$symb,$role)=@_; + my ($priv,$uri,$symb,$role,$clientip,$noblockcheck)=@_; my $ver_orguri=$uri; $uri=&deversion($uri); my $orguri=$uri; @@ -6894,11 +6894,16 @@ sub allowed { if ($match) { if ($env{'user.priv.'.$env{'request.role'}.'./'} =~/\Q$priv\E\&([^\:]*)/) { - my @blockers = &has_comm_blocking($priv,$symb,$uri); - if (@blockers > 0) { - $thisallowed = 'B'; + my $value = $1; + if ($noblockcheck) { + $thisallowed.=$value; } else { - $thisallowed.=$1; + my @blockers = &has_comm_blocking($priv,$symb,$uri); + if (@blockers > 0) { + $thisallowed = 'B'; + } else { + $thisallowed.=$value; + } } } } else { @@ -6910,11 +6915,15 @@ sub allowed { $refuri=&declutter($refuri); my ($match) = &is_on_map($refuri); if ($match) { - my @blockers = &has_comm_blocking($priv,$symb,$refuri); - if (@blockers > 0) { - $thisallowed = 'B'; - } else { + if ($noblockcheck) { $thisallowed='F'; + } else { + my @blockers = &has_comm_blocking($priv,$symb,$refuri); + if (@blockers > 0) { + $thisallowed = 'B'; + } else { + $thisallowed='F'; + } } } } @@ -6969,11 +6978,15 @@ sub allowed { =~/\Q$priv\E\&([^\:]*)/) { my $value = $1; if ($priv eq 'bre') { - my @blockers = &has_comm_blocking($priv,$symb,$uri); - if (@blockers > 0) { - $thisallowed = 'B'; - } else { + if ($noblockcheck) { $thisallowed.=$value; + } else { + my @blockers = &has_comm_blocking($priv,$symb,$uri); + if (@blockers > 0) { + $thisallowed = 'B'; + } else { + $thisallowed.=$value; + } } } else { $thisallowed.=$value; @@ -7007,11 +7020,15 @@ sub allowed { =~/\Q$priv\E\&([^\:]*)/) { my $value = $1; if ($priv eq 'bre') { - my @blockers = &has_comm_blocking($priv,$symb,$refuri); - if (@blockers > 0) { - $thisallowed = 'B'; - } else { + if ($noblockcheck) { $thisallowed.=$value; + } else { + my @blockers = &has_comm_blocking($priv,$symb,$refuri); + if (@blockers > 0) { + $thisallowed = 'B'; + } else { + $thisallowed.=$value; + } } } else { $thisallowed.=$value; @@ -7331,13 +7348,15 @@ sub has_comm_blocking { if ($mapsymb) { if (ref($navmap)) { my $mapres = $navmap->getBySymb($mapsymb); - @to_test = $mapres->retrieveResources($mapres,undef,0,1); + @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); - last; + if ($interval[1] eq 'map') { + last; + } } } } @@ -12698,7 +12717,7 @@ were new keys. I.E. 1:foo will become 1: Calling convention: my %record=&Apache::lonnet::restore($symb,$courseid,$domain,$uname); - &Apache::lonnet::cstore(\%newrecord,$symb,$courseid,$domain,$uname); + &Apache::lonnet::cstore(\%newrecord,$symb,$courseid,$domain,$uname,$laststore); For more detailed information, see lonnet specific documentation. @@ -12834,13 +12853,29 @@ escaped strings of the action recorded i =item * -allowed($priv,$uri,$symb,$role) : check for a user privilege; returns codes for allowed actions +allowed($priv,$uri,$symb,$role,$clientip,$noblockcheck) : check for a user privilege; +returns codes for allowed actions. + +The first argument is required, all others are optional. + +$priv is the privilege being checked. +$uri contains additional information about what is being checked for access (e.g., +URL, course ID etc.). +$symb is the unique resource instance identifier in a course; if needed, +but not provided, it will be retrieved via a call to &symbread(). +$role is the role for which a priv is being checked (only used if priv is evb). +$clientip is the user's IP address (only used when checking for access to portfolio +files). +$noblockcheck, if true, skips calls to &has_comm_blocking() for the bre priv. This +prevents recursive calls to &allowed. + F: full access U,I,K: authentication modes (cxx only) '': forbidden 1: user needs to choose course 2: browse allowed A: passphrase authentication needed + B: access temporarily blocked because of a blocking event in a course. =item * @@ -13335,15 +13370,21 @@ homeserver. =item * -store($storehash,$symb,$namespace,$udom,$uname) : stores hash permanently -for this url; hashref needs to be given and should be a \%hashname; the -remaining args aren't required and if they aren't passed or are '' they will -be derived from the env +store($storehash,$symb,$namespace,$udom,$uname,$laststore) : stores hash +permanently for this url; hashref needs to be given and should be a \%hashname; +the remaining args aren't required and if they aren't passed or are '' they will +be derived from the env (with the exception of $laststore, which is an +optional arg used when a user's submission is stored in grading). +$laststore is $version=$timestamp, where $version is the most recent version +number retrieved for the corresponding $symb in the $namespace db file, and +$timestamp is the timestamp for that transaction (UNIX time). +$laststore is currently only passed when cstore() is called by +structuretags::finalize_storage(). =item * -cstore($storehash,$symb,$namespace,$udom,$uname) : same as store but -uses critical subroutine +cstore($storehash,$symb,$namespace,$udom,$uname,$laststore) : same as store +but uses critical subroutine =item *