loncom/interface/loncommon.pm - diff

Return to loncommon.pm CVS log

Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/loncommon.pm between versions 1.1370 and 1.1373

-version 1.1370, 2021/11/17 19:55:15
+version 1.1373, 2021/12/24 00:48:30
  Line 5201  sub findallcourses {
  ###############################################
  sub blockcheck {
-     my ($setters,$activity,$uname,$udom,$url,$is_course,$symb,$caller) = @_;
+     my ($setters,$activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller) = @_;
+     unless (($activity eq 'docs') || ($activity eq 'reinit') || ($activity eq 'alert')) {
+         my ($has_evb,$check_ipaccess);
+         my $dom = $env{'user.domain'};
+         if ($env{'request.course.id'}) {
+             my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
+             my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
+             my $checkrole = "cm./$cdom/$cnum";
+             my $sec = $env{'request.course.sec'};
+             if ($sec ne '') {
+                 $checkrole .= "/$sec";
+             }
+             if ((&Apache::lonnet::allowed('evb',undef,undef,$checkrole)) &&
+                 ($env{'request.role'} !~ /^st/)) {
+                 $has_evb = 1;
+             }
+             unless ($has_evb) {
+                 if (($activity eq 'printout') || ($activity eq 'grades') || ($activity eq 'search') ||
+                     ($activity eq 'boards') || ($activity eq 'groups') || ($activity eq 'chat')) {
+                     if ($udom eq $cdom) {
+                         $check_ipaccess = 1;
+                     }
+                 }
+             }
+         }
+         unless ($has_evb || $check_ipaccess) {
+             my @machinedoms = &Apache::lonnet::current_machine_domains();
+             if (($dom eq 'public') && ($activity eq 'port')) {
+                 $dom = $udom;
+             }
+             if (($dom ne '') && (grep(/^\Q$dom\E$/,@machinedoms))) {
+                 $check_ipaccess = 1;
+             } else {
+                 my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
+                 my $internet_names = &Apache::lonnet::get_internet_names($lonhost);
+                 my $prim = &Apache::lonnet::domain($dom,'primary');
+                 my $intdom = &Apache::lonnet::internet_dom($prim);
+                 if (($intdom ne '') && (ref($internet_names) eq 'ARRAY')) {
+                     if (grep(/^\Q$intdom\E$/,@{$internet_names})) {
+                         $check_ipaccess = 1;
+                     }
+                 }
+             }
+         }
+         if ($check_ipaccess) {
+             my ($ipaccessref,$cached)=&Apache::lonnet::is_cached_new('ipaccess',$dom);
+             unless (defined($cached)) {
+                 my %domconfig =
+                     &Apache::lonnet::get_dom('configuration',['ipaccess'],$dom);
+                 $ipaccessref = &Apache::lonnet::do_cache_new('ipaccess',$dom,$domconfig{'ipaccess'},1800);
+             }
+             if ((ref($ipaccessref) eq 'HASH') && ($clientip)) {
+                 foreach my $id (keys(%{$ipaccessref})) {
+                     if (ref($ipaccessref->{$id}) eq 'HASH') {
+                         my $range = $ipaccessref->{$id}->{'ip'};
+                         if ($range) {
+                             if (&Apache::lonnet::ip_match($clientip,$range)) {
+                                 if (ref($ipaccessref->{$id}->{'commblocks'}) eq 'HASH') {
+                                     if ($ipaccessref->{$id}->{'commblocks'}->{$activity} eq 'on') {
+                                         return ('','','',$id,$dom);
+                                         last;
+                                     }
+                                 }
+                             }
+                         }
+                     }
+                 }
+             }
+         }
+         if (($activity eq 'wishlist') || ($activity eq 'annotate')) {
+             return ();
+         }
+     }
      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))) {
- Line 5218  sub blockcheck {
+ Line 5289  sub blockcheck {
      my $startblock = 0;
      my $endblock = 0;
      my $triggerblock = '';
-     my %live_courses = &findallcourses(undef,$uname,$udom);
+     my %live_courses;
+     unless (($activity eq 'wishlist') || ($activity eq 'annotate')) {
+         %live_courses = &findallcourses(undef,$uname,$udom);
+     }
      # If uname is for a user, and activity is course-specific, i.e.,
      # boards, chat or groups, check for blocking in current course only.
- Line 5503  sub parse_block_record {
+ Line 5577  sub parse_block_record {
  }
  sub blocking_status {
-     my ($activity,$uname,$udom,$url,$is_course,$symb,$caller) = @_;
+     my ($activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller) = @_;
      my %setters;
  # check for active blocking
-     my ($startblock,$endblock,$triggerblock) =
+     if ($clientip eq '') {
-         &blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course,$symb,$caller);
+         $clientip = &Apache::lonnet::get_requestor_ip();
+     }
+     my ($startblock,$endblock,$triggerblock,$by_ip,$blockdom) =
+         &blockcheck(\%setters,$activity,$clientip,$uname,$udom,$url,$is_course,$symb,$caller);
      my $blocked = 0;
-     if ($startblock && $endblock) {
+     if (($startblock && $endblock) || ($by_ip)) {
          $blocked = 1;
      }
- Line 5564  END_MYBLOCK
+ Line 5641  END_MYBLOCK
          $text = &mt('Checking Course Update Blocked');
      } elsif ($activity eq 'about') {
          $text = &mt('Access to User Information Pages Blocked');
+     } elsif ($activity eq 'wishlist') {
+         $text = &mt('Access to Stored Links Blocked');
+     } elsif ($activity eq 'annotate') {
+         $text = &mt('Access to Annotations Blocked');
      }
      $output .= <<"END_BLOCK";
  <div class='$class'>
- Line 8858  sub print_suppression {
+ Line 8939  sub print_suppression {
          }
          my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
          my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
-         my $blocked = &blocking_status('printout',$cnum,$cdom,undef,1);
+         my $clientip = &Apache::lonnet::get_requestor_ip();
+         my $blocked = &blocking_status('printout',$clientip,$cnum,$cdom,undef,1);
          if ($blocked) {
              my $checkrole = "cm./$cdom/$cnum";
              if ($env{'request.course.sec'} ne '') {
- Line 16452  sub construct_course {
+ Line 16534  sub construct_course {
      if ($args->{'crstype'}) {
          $cenv{'type'}=$args->{'crstype'};
      }
+     if ($args->{'lti'}) {
+         $cenv{'internal.lti'}=$args->{'lti'};
+     }
      if ($args->{'crsid'}) {
          $cenv{'courseid'}=$args->{'crsid'};
      }
- Line 17951  sub needs_coursereinit {
+ Line 18036  sub needs_coursereinit {
      }
      if (($now-$env{'request.course.timechecked'})>$interval) {
          &Apache::lonnet::appenv({'request.course.timechecked'=>$now});
-         my $blocked = &blocking_status('reinit',$cnum,$cdom,undef,1);
+         my $blocked = &blocking_status('reinit',undef,$cnum,$cdom,undef,1);
          if ($blocked) {
              return ();
          }
- Line 18478  sub critical_redirect {
+ Line 18563  sub critical_redirect {
          if (($env{'request.course.id'}) && (($context eq 'flip') || ($context eq 'contents'))) {
              my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
              my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
-             my $blocked = &blocking_status('alert',$cnum,$cdom,undef,1);
+             my $blocked = &blocking_status('alert',undef,$cnum,$cdom,undef,1);
              if ($blocked) {
                  my $checkrole = "cm./$cdom/$cnum";
                  if ($env{'request.course.sec'} ne '') {

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>

Removed from v.1.1370
changed lines
	Added in v.1.1373