--- loncom/interface/loncommon.pm	2017/04/02 03:09:27	1.1075.2.127
+++ loncom/interface/loncommon.pm	2020/02/19 23:36:09	1.1075.2.127.6.2
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # a pile of common routines
 #
-# $Id: loncommon.pm,v 1.1075.2.127 2017/04/02 03:09:27 raeburn Exp $
+# $Id: loncommon.pm,v 1.1075.2.127.6.2 2020/02/19 23:36:09 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -4946,17 +4946,43 @@ sub check_ip_acc {
     if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
         return 1;
     }
-    my $allowed=0;
-    my $ip=$ENV{'REMOTE_ADDR'} || $clientip || $env{'request.host'};
+    my ($ip,$allowed);
+    if (($ENV{'REMOTE_ADDR'} eq '127.0.0.1') ||
+        ($ENV{'REMOTE_ADDR'} eq &Apache::lonnet::get_host_ip($Apache::lonnet::perlvar{'lonHostID'}))) {
+        $ip = $env{'request.host'} || $ENV{'REMOTE_ADDR'} || $clientip;
+    } else {
+        $ip = $ENV{'REMOTE_ADDR'} || $env{'request.host'} || $clientip;
+    }
 
     my $name;
-    foreach my $pattern (split(',',$acc)) {
-        $pattern =~ s/^\s*//;
-        $pattern =~ s/\s*$//;
+    my %access = (
+                     allowfrom => 1,
+                     denyfrom  => 0,
+                 );
+    my @allows;
+    my @denies;
+    foreach my $item (split(',',$acc)) {
+        $item =~ s/^\s*//;
+        $item =~ s/\s*$//;
+        if ($item =~ /^\!(.+)$/) {
+            push(@denies,$1);
+        } else {
+            push(@allows,$item);
+        }
+    }
+    my $numdenies = scalar(@denies);
+    my $numallows = scalar(@allows);
+    my $count = 0;
+    foreach my $pattern (@denies,@allows) {
+        $count ++;
+        my $acctype = 'allowfrom';
+        if ($count <= $numdenies) {
+            $acctype = 'denyfrom';
+        }
         if ($pattern =~ /\*$/) {
             #35.8.*
             $pattern=~s/\*//;
-            if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
+            if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
         } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {
             #35.8.3.[34-56]
             my $low=$2;
@@ -4964,7 +4990,7 @@ sub check_ip_acc {
             $pattern=$1;
             if ($ip =~ /^\Q$pattern\E/) {
                 my $last=(split(/\./,$ip))[3];
-                if ($last <=$high && $last >=$low) { $allowed=1; }
+                if ($last <=$high && $last >=$low) { $allowed=$access{$acctype}; }
             }
         } elsif ($pattern =~ /^\*/) {
             #*.msu.edu
@@ -4974,10 +5000,10 @@ sub check_ip_acc {
                 my $netaddr=inet_aton($ip);
                 ($name)=gethostbyaddr($netaddr,AF_INET);
             }
-            if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
+            if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
         } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {
             #127.0.0.1
-            if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }
+            if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; }
         } else {
             #some.name.com
             if (!defined($name)) {
@@ -4985,9 +5011,16 @@ sub check_ip_acc {
                 my $netaddr=inet_aton($ip);
                 ($name)=gethostbyaddr($netaddr,AF_INET);
             }
-            if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }
+            if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; }
+        }
+        if ($allowed =~ /^(0|1)$/) { last; }
+    }
+    if ($allowed eq '') {
+        if ($numdenies && !$numallows) {
+            $allowed = 1;
+        } else {
+            $allowed = 0;
         }
-        if ($allowed) { last; }
     }
     return $allowed;
 }