--- loncom/lonnet/perl/lonnet.pm	2021/06/20 16:39:27	1.1172.2.141
+++ loncom/lonnet/perl/lonnet.pm	2021/12/14 20:23:40	1.1172.2.142
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1172.2.141 2021/06/20 16:39:27 raeburn Exp $
+# $Id: lonnet.pm,v 1.1172.2.142 2021/12/14 20:23:40 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -95,6 +95,8 @@ use Cache::Memcached;
 use Digest::MD5;
 use Math::Random;
 use File::MMagic;
+use Net::CIDR;
+use Sys::Hostname::FQDN();
 use LONCAPA qw(:DEFAULT :match);
 use LONCAPA::Configuration;
 use LONCAPA::lonmetadata;
@@ -689,6 +691,9 @@ sub check_for_valid_session {
     if (ref($userhashref) eq 'HASH') {
         $userhashref->{'name'} = $disk_env{'user.name'};
         $userhashref->{'domain'} = $disk_env{'user.domain'};
+        if ($disk_env{'request.role'}) {
+            $userhashref->{'role'} = $disk_env{'request.role'};
+        }
     }
     untie(%disk_env);
 
@@ -917,7 +922,7 @@ sub userload {
 # ------------------------------ Find server with least workload from spare.tab
 
 sub spareserver {
-    my ($loadpercent,$userloadpercent,$want_server_name,$udom) = @_;
+    my ($r,$loadpercent,$userloadpercent,$want_server_name,$udom) = @_;
     my $spare_server;
     if ($userloadpercent !~ /\d/) { $userloadpercent=0; }
     my $lowest_load=($loadpercent > $userloadpercent) ? $loadpercent 
@@ -962,6 +967,8 @@ sub spareserver {
                 if ($protocol{$spare_server} eq 'https') {
                     $protocol = $protocol{$spare_server};
                 }
+                my $alias = &Apache::lonnet::use_proxy_alias($r,$spare_server);
+                $hostname = $alias if ($alias ne '');
 	        $spare_server = $protocol.'://'.$hostname;
             }
         }
@@ -2024,7 +2031,7 @@ sub retrieve_inst_usertypes {
 
 sub is_domainimage {
     my ($url) = @_;
-    if ($url=~m-^/+res/+($match_domain)/+\1\-domainconfig/+(img|logo|domlogo)/+[^/]-) {
+    if ($url=~m-^/+res/+($match_domain)/+\1\-domainconfig/+(img|logo|domlogo|login)/+[^/]-) {
         if (&domain($1) ne '') {
             return '1';
         }
@@ -2482,6 +2489,13 @@ sub get_domain_defaults {
             $domdefaults{'adhocroles'} = $domconfig{'helpsettings'}{'adhoc'};
         }
     }
+    if (ref($domconfig{'wafproxy'}) eq 'HASH') {
+        foreach my $item ('ipheader','trusted','vpnint','vpnext','sslopt') {
+            if ($domconfig{'wafproxy'}{$item}) {
+                $domdefaults{'waf_'.$item} = $domconfig{'wafproxy'}{$item};
+            }
+        }
+    }
     &do_cache_new('domdefaults',$domain,\%domdefaults,$cachetime);
     return %domdefaults;
 }
@@ -4601,6 +4615,29 @@ sub flushcourselogs {
             if (! defined($dom) || $dom eq '' || 
                 ! defined($name) || $name eq '') {
                 my $cid = $env{'request.course.id'};
+#
+# FIXME 11/29/2021
+# Typo in rev. 1.458 (2003/12/09)??
+# These should likely by $env{'course.'.$cid.'.domain'} and $env{'course.'.$cid.'.num'}
+#
+# While these ramain as  $env{'request.'.$cid.'.domain'} and $env{'request.'.$cid.'.num'}
+# $dom and $name will always be null, so the &inc() call will default to storing this data
+# in a nohist_accesscount.db file for the user rather than the course.
+#
+# That said there is a lot of noise in the data being stored.
+# So counts for prtspool/  and adm/ etc. are recorded.
+#
+# A review of which items ending '___count' are written to %accesshash should likely be
+# made before deciding whether to set these to 'course.' instead of 'request.'
+#
+# Under the current scheme each user receives a nohist_accesscount.db file listing
+# accesses for things which are not published resources, regardless of course, and
+# there is not a nohist_accesscount.db file in a course, which might log accesses from
+# anyone in the course for things which are not published resources.
+#
+# For an author, nohist_accesscount.db ends up having records for other items
+# mixed up with the legitimate access counts for the author's published resources.
+#
                 $dom  = $env{'request.'.$cid.'.domain'};
                 $name = $env{'request.'.$cid.'.num'};
             }
@@ -7272,15 +7309,15 @@ sub portfolio_access {
     if ($result) {
         my %setters;
         if ($env{'user.name'} eq 'public' && $env{'user.domain'} eq 'public') {
-            my ($startblock,$endblock) =
-                &Apache::loncommon::blockcheck(\%setters,'port',$unum,$udom);
-            if ($startblock && $endblock) {
+            my ($startblock,$endblock,$triggerblock,$by_ip,$blockdom) =
+                &Apache::loncommon::blockcheck(\%setters,'port',$clientip,$unum,$udom);
+            if (($startblock && $endblock) || ($by_ip))  {
                 return 'B';
             }
         } else {
-            my ($startblock,$endblock) =
-                &Apache::loncommon::blockcheck(\%setters,'port');
-            if ($startblock && $endblock) {
+            my ($startblock,$endblock,$triggerblock,$by_ip,$blockdo) =
+                &Apache::loncommon::blockcheck(\%setters,'port',$clientip);
+            if (($startblock && $endblock) || ($by_ip)) {
                 return 'B';
             }
         }
@@ -7857,9 +7894,9 @@ sub allowed {
     if (($space=~/^(uploaded|editupload)$/) && ($env{'user.name'} eq $name) && 
 	($env{'user.domain'} eq $domain) && ('portfolio' eq $dir[0])) {
         my %setters;
-        my ($startblock,$endblock) = 
-            &Apache::loncommon::blockcheck(\%setters,'port');
-        if ($startblock && $endblock) {
+        my ($startblock,$endblock,$triggerblock,$by_ip,$blockdom) = 
+            &Apache::loncommon::blockcheck(\%setters,'port',$clientip);
+        if (($startblock && $endblock) || ($by_ip)) {
             return 'B';
         } else {
             return 'F';
@@ -7952,8 +7989,8 @@ sub allowed {
                         my $adom = $1;
                         foreach my $key (keys(%env)) {
                             if ($key =~ m{^user\.role\.(ca|aa)/\Q$adom\E}) {
-                                my ($start,$end) = split('.',$env{$key});
-                                if (($now >= $start) && (!$end || $end < $now)) {
+                                my ($start,$end) = split(/\./,$env{$key});
+                                if (($now >= $start) && (!$end || $end > $now)) {
                                     $ownaccess = 1;
                                     last;
                                 }
@@ -7965,8 +8002,8 @@ sub allowed {
                         foreach my $role ('ca','aa') { 
                             if ($env{"user.role.$role./$adom/$aname"}) {
                                 my ($start,$end) =
-                                    split('.',$env{"user.role.$role./$adom/$aname"});
-                                if (($now >= $start) && (!$end || $end < $now)) {
+                                    split(/\./,$env{"user.role.$role./$adom/$aname"});
+                                if (($now >= $start) && (!$end || $end > $now)) {
                                     $ownaccess = 1;
                                     last;
                                 }
@@ -8231,16 +8268,48 @@ sub allowed {
 #
 
 # Possibly locked functionality, check all courses
+# In roles.tab, L (unless locked) available for bre, pch, plc, pac and sma.
 # Locks might take effect only after 10 minutes cache expiration for other
-# courses, and 2 minutes for current course
+# courses, and 2 minutes for current course, in which user has st or ta role
+# which is neither expired nor a future role (unless current course).
 
-    my $envkey;
+    my ($needlockcheck,$now,$crsonly);
     if ($thisallowed=~/L/) {
-        foreach $envkey (keys(%env)) {
+        $now = time;
+        if ($priv eq 'bre') {
+            if ($uri ne '') {
+                if ($orguri =~ m{^/+res/}) {
+                    if ($uri =~ m{^lib/templates/}) {
+                        if ($env{'request.course.id'}) {
+                            $crsonly = 1;
+                            $needlockcheck = 1;
+                        }
+                    } else {
+                        $needlockcheck = 1;
+                    }
+                } elsif ($env{'request.course.id'}) {
+                    my ($crsdom,$crsnum) = split('_',$env{'request.course.id'});
+                    if (($uri =~ m{^(adm|uploaded|public)/$crsdom/$crsnum/}) ||
+                        ($uri =~ m{^adm/$match_domain/$match_username/\d+/(smppg|bulletinboard)$})) {
+                        $crsonly = 1;
+                    }
+                    $needlockcheck = 1;
+                }
+            }
+        } elsif (($priv eq 'pch') || ($priv eq 'plc') || ($priv eq 'pac') || ($priv eq 'sma')) {
+            $needlockcheck = 1;
+        }
+    }
+    if ($needlockcheck) {
+        foreach my $envkey (keys(%env)) {
            if ($envkey=~/^user\.role\.(st|ta)\.([^\.]*)/) {
                my $courseid=$2;
                my $roleid=$1.'.'.$2;
                $courseid=~s/^\///;
+               unless ($env{'request.role'} eq $roleid) {
+                   my ($start,$end) = split(/\./,$env{$envkey});
+                   next unless (($now >= $start) && (!$end || $end > $now));
+               }
                my $expiretime=600;
                if ($env{'request.role'} eq $roleid) {
 		  $expiretime=120;
@@ -8263,7 +8332,7 @@ sub allowed {
                }
                if (($env{$prefix.'priv.'.$priv.'.lock.sections'}=~/\,\Q$csec\E\,/)
                 || ($env{$prefix.'priv.'.$priv.'.lock.sections'} eq 'all')) {
-		   if ($env{'priv.'.$priv.'.lock.expire'}>time) {
+		   if ($env{$prefix.'priv.'.$priv.'.lock.expire'}>time) {
                        &log($env{'user.domain'},$env{'user.name'},
                             $env{'user.home'},
                             'Locked by priv: '.$priv.' for '.$uri.' due to '.
@@ -8480,7 +8549,11 @@ sub get_commblock_resources {
     my ($blocks) = @_;
     my %blockers = ();
     return %blockers unless ($env{'request.course.id'});
-    return %blockers if ($env{'user.priv.'.$env{'request.role'}} =~/evb\&([^\:]*)/);
+    my $courseurl = &courseid_to_courseurl($env{'request.course.id'});
+    if ($env{'request.course.sec'}) {
+        $courseurl .= '/'.$env{'request.course.sec'};
+    }
+    return %blockers if ($env{'user.priv.'.$env{'request.role'}.'.'.$courseurl} =~/evb\&([^\:]*)/);
     my %commblocks;
     if (ref($blocks) eq 'HASH') {
         %commblocks = %{$blocks};
@@ -8512,10 +8585,9 @@ sub get_commblock_resources {
             }
         } elsif ($block =~ /^firstaccess____(.+)$/) {
             my $item = $1;
-            my @to_test;
             if (ref($commblocks{$block}{'blocks'}) eq 'HASH') {
                 if (ref($commblocks{$block}{'blocks'}{'docs'}) eq 'HASH') {
-                    my @interval;
+                    my (@interval,$mapname);
                     my $type = 'map';
                     if ($item eq 'course') {
                         $type = 'course';
@@ -8524,36 +8596,11 @@ sub get_commblock_resources {
                         if ($item =~ /___\d+___/) {
                             $type = 'resource';
                             @interval=&EXT("resource.0.interval",$item);
-                            if (ref($navmap)) {
-                                my $res = $navmap->getBySymb($item);
-                                push(@to_test,$res);
-                            }
                         } else {
-                            my $mapsymb = &symbread($item,1);
-                            if ($mapsymb) {
-                                if (ref($navmap)) {
-                                    my $mapres = $navmap->getBySymb($mapsymb);
-                                    if (ref($mapres)) {
-                                        my $first = $mapres->map_start();
-                                        my $finish = $mapres->map_finish();
-                                        my $it = $navmap->getIterator($first,$finish,undef,0,0);
-                                        if (ref($it)) {
-                                            my $res;
-                                            while ($res = $it->next(undef,1)) {
-                                                next unless (ref($res));
-                                                my $symb = $res->symb();
-                                                next if (($symb eq $mapsymb) || ($symb eq ''));
-                                                @interval=&EXT("resource.0.interval",$symb);
-                                                if ($interval[1] eq 'map') {
-                                                    if ($res->answerable()) {
-                                                        push(@to_test,$res);
-                                                        last;
-                                                    }
-                                                }
-                                            }
-                                        }
-                                    }
-                                }
+                            $mapname = &deversion($item);
+                            if (ref($navmap)) {
+                                my $timelimit = $navmap->get_mapparam(undef,$mapname,'0.interval');
+                                @interval = ($timelimit,'map');
                             }
                         }
                     }
@@ -8570,10 +8617,37 @@ sub get_commblock_resources {
                             my $timesup = $first_access+$interval[0];
                             if ($timesup > $now) {
                                 my $activeblock;
-                                foreach my $res (@to_test) {
-                                    if ($res->answerable()) {
-                                        $activeblock = 1;
-                                        last;
+                                if ($type eq 'resource') {
+                                    if (ref($navmap)) {
+                                        my $res = $navmap->getBySymb($item);
+                                        if ($res->answerable()) {
+                                            $activeblock = 1;
+                                        }
+                                    }
+                                } elsif ($type eq 'map') {
+                                    my $mapsymb = &symbread($mapname,1);
+                                    if (($mapsymb) && (ref($navmap))) {
+                                        my $mapres = $navmap->getBySymb($mapsymb);
+                                        if (ref($mapres)) {
+                                            my $first = $mapres->map_start();
+                                            my $finish = $mapres->map_finish();
+                                            my $it = $navmap->getIterator($first,$finish,undef,0,0);
+                                            if (ref($it)) {
+                                                my $res;
+                                                while ($res = $it->next(undef,1)) {
+                                                    next unless (ref($res));
+                                                    my $symb = $res->symb();
+                                                    next if (($symb eq $mapsymb) || ($symb eq ''));
+                                                    @interval=&EXT("resource.0.interval",$symb);
+                                                    if ($interval[1] eq 'map') {
+                                                        if ($res->answerable()) {
+                                                            $activeblock = 1;
+                                                            last;
+                                                        }
+                                                    }
+                                                }
+                                            }
+                                        }
                                     }
                                 }
                                 if ($activeblock) {
@@ -8603,8 +8677,12 @@ sub has_comm_blocking {
     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');
+    my $courseurl = &courseid_to_courseurl($env{'request.course.id'});
+    if ($env{'request.course.sec'}) {
+        $courseurl .= '/'.$env{'request.course.sec'};
+    }
+    return if ($env{'user.priv.'.$env{'request.role'}.'.'.$courseurl} =~/evb\&([^\:]*)/);
     my %blockinfo;
     if (ref($blocks) eq 'HASH') {
         %blockinfo = &get_commblock_resources($blocks);
@@ -11487,7 +11565,7 @@ sub EXT {
 	    if ( (defined($Apache::lonhomework::parsing_a_problem)
 		  || defined($Apache::lonhomework::parsing_a_task))
 		 &&
-		 ($symbparm eq &symbread()) ) {	
+		 ($symbparm eq &symbread()) ) {
 		# if we are in the middle of processing the resource the
 		# get the value we are planning on committing
                 if (defined($Apache::lonhomework::results{$qualifierrest})) {
@@ -13408,10 +13486,15 @@ sub machine_ids {
 
 sub additional_machine_domains {
     my @domains;
-    open(my $fh,"<","$perlvar{'lonTabDir'}/expected_domains.tab");
-    while( my $line = <$fh>) {
-        $line =~ s/\s//g;
-        push(@domains,$line);
+    if (-e "$perlvar{'lonTabDir'}/expected_domains.tab") {
+        if (open(my $fh,"<","$perlvar{'lonTabDir'}/expected_domains.tab")) {
+            while( my $line = <$fh>) {
+                chomp($line);
+                $line =~ s/\s//g;
+                push(@domains,$line);
+            }
+            close($fh);
+        }
     }
     return @domains;
 }
@@ -13492,17 +13575,230 @@ sub uses_sts {
     return;
 }
 
+sub waf_allssl {
+    my ($host_name) = @_;
+    my $alias = &get_proxy_alias();
+    if ($host_name eq '') {
+        $host_name = $ENV{'SERVER_NAME'};
+    }
+    if (($host_name ne '') && ($alias eq $host_name)) {
+        my $serverhomedom = &host_domain($perlvar{'lonHostID'});
+        my %defdomdefaults = &get_domain_defaults($serverhomedom);
+        if ($defdomdefaults{'waf_sslopt'}) {
+            return $defdomdefaults{'waf_sslopt'};
+        }
+    }
+    return;
+}
+
 sub get_requestor_ip {
     my ($r,$nolookup,$noproxy) = @_;
     my $from_ip;
     if (ref($r)) {
-        $from_ip = $r->get_remote_host($nolookup);
+        if ($r->can('useragent_ip')) {
+            if ($noproxy && $r->can('client_ip')) {
+                $from_ip = $r->client_ip();
+            } else {
+                $from_ip = $r->useragent_ip();
+            }
+        } elsif ($r->connection->can('remote_ip')) {
+            $from_ip = $r->connection->remote_ip();
+        } else {
+            $from_ip = $r->get_remote_host($nolookup);
+        }
     } else {
         $from_ip = $ENV{'REMOTE_ADDR'};
     }
+    return $from_ip if ($noproxy);
+   # Who controls proxy settings for server
+    my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
+    my $proxyinfo = &get_proxy_settings($dom_in_use);
+    if ((ref($proxyinfo) eq 'HASH') && ($from_ip)) {
+        if ($proxyinfo->{'vpnint'}) {
+            if (&ip_match($from_ip,$proxyinfo->{'vpnint'})) {
+                return $from_ip;
+            }
+        }
+        if ($proxyinfo->{'trusted'}) {
+            if (&ip_match($from_ip,$proxyinfo->{'trusted'})) {
+                my $ipheader = $proxyinfo->{'ipheader'};
+                my ($ip,$xfor);
+                if (ref($r)) {
+                    if ($ipheader) {
+                        $ip = $r->headers_in->{$ipheader};
+                    }
+                    $xfor = $r->headers_in->{'X-Forwarded-For'};
+                } else {
+                    if ($ipheader) {
+                        $ip = $ENV{'HTTP_'.uc($ipheader)};
+                    }
+                    $xfor = $ENV{'HTTP_X_FORWARDED_FOR'};
+                }
+                if (($ip eq '') && ($xfor ne '')) {
+                    foreach my $poss_ip (reverse(split(/\s*,\s*/,$xfor))) {
+                        unless (&ip_match($poss_ip,$proxyinfo->{'trusted'})) {
+                            $ip = $poss_ip;
+                            last;
+                        }
+                    }
+                }
+                if ($ip ne '') {
+                    return $ip;
+                }
+            }
+        }
+    }
     return $from_ip;
 }
 
+sub get_proxy_settings {
+    my ($dom_in_use) = @_;
+    my %domdefaults = &Apache::lonnet::get_domain_defaults($dom_in_use);
+    my $proxyinfo = {
+                       ipheader => $domdefaults{'waf_ipheader'},
+                       trusted  => $domdefaults{'waf_trusted'},
+                       vpnint   => $domdefaults{'waf_vpnint'},
+                       vpnext   => $domdefaults{'waf_vpnext'},
+                       sslopt   => $domdefaults{'waf_sslopt'},
+                    };
+    return $proxyinfo;
+}
+
+sub ip_match {
+    my ($ip,$pattern_str) = @_;
+    $ip=Net::CIDR::cidrvalidate($ip);
+    if ($ip) {
+        return Net::CIDR::cidrlookup($ip,split(/\s*,\s*/,$pattern_str));
+    }
+    return;
+}
+
+sub get_proxy_alias {
+    my ($lonid) = @_;
+    if ($lonid eq '') {
+        $lonid = $perlvar{'lonHostID'};
+    }
+    if (!defined(&hostname($lonid))) {
+        return;
+    }
+    if ($lonid ne '') {
+        my ($alias,$cached) = &is_cached_new('proxyalias',$lonid);
+        if ($cached) {
+            return $alias;
+        }
+        my $dom = &Apache::lonnet::host_domain($lonid);
+        if ($dom ne '') {
+            my $cachetime = 60*60*24;
+            my %domconfig =
+                &Apache::lonnet::get_dom('configuration',['wafproxy'],$dom);
+            if (ref($domconfig{'wafproxy'}) eq 'HASH') {
+                if (ref($domconfig{'wafproxy'}{'alias'}) eq 'HASH') {
+                    $alias = $domconfig{'wafproxy'}{'alias'}{$lonid};
+                }
+            }
+            return &do_cache_new('proxyalias',$lonid,$alias,$cachetime);
+        }
+    }
+    return;
+}
+
+sub use_proxy_alias {
+    my ($r,$lonid) = @_;
+    my $alias = &get_proxy_alias($lonid);
+    if ($alias) {
+        my $dom = &host_domain($lonid);
+        if ($dom ne '') {
+            my $proxyinfo = &get_proxy_settings($dom);
+            my ($vpnint,$remote_ip);
+            if (ref($proxyinfo) eq 'HASH') {
+                $vpnint = $proxyinfo->{'vpnint'};
+                if ($vpnint) {
+                    $remote_ip = &get_requestor_ip($r,1,1);
+                }
+            }
+            unless ($vpnint && &ip_match($remote_ip,$vpnint)) {
+                return $alias;
+            }
+        }
+    }
+    return;
+}
+
+sub alias_sso {
+    my ($lonid) = @_;
+    if ($lonid eq '') {
+        $lonid = $perlvar{'lonHostID'};
+    }
+    if (!defined(&hostname($lonid))) {
+        return;
+    }
+    if ($lonid ne '') {
+        my ($use_alias,$cached) = &is_cached_new('proxysaml',$lonid);
+        if ($cached) {
+            return $use_alias;
+        }
+        my $dom = &Apache::lonnet::host_domain($lonid);
+        if ($dom ne '') {
+            my $cachetime = 60*60*24;
+            my %domconfig =
+                &Apache::lonnet::get_dom('configuration',['wafproxy'],$dom);
+            if (ref($domconfig{'wafproxy'}) eq 'HASH') {
+                if (ref($domconfig{'wafproxy'}{'saml'}) eq 'HASH') {
+                    $use_alias = $domconfig{'wafproxy'}{'saml'}{$lonid};
+                }
+            }
+            return &do_cache_new('proxysaml',$lonid,$use_alias,$cachetime);
+        }
+    }
+    return;
+}
+
+sub get_saml_landing {
+    my ($lonid) = @_;
+    if ($lonid eq '') {
+        my $defdom = &default_login_domain();
+        my @hosts = &current_machine_ids();
+        if (@hosts > 1) {
+            foreach my $hostid (@hosts) {
+                if (&host_domain($hostid) eq $defdom) {
+                    $lonid = $hostid;
+                    last;
+                }
+            }
+        } else {
+            $lonid = $perlvar{'lonHostID'};
+        }
+        if ($lonid) {
+            unless (&Apache::lonnet::host_domain($lonid) eq $defdom) {
+                return;
+            }
+        } else {
+            return;
+        }
+    } elsif (!defined(&hostname($lonid))) {
+        return;
+    }
+    my ($landing,$cached) = &is_cached_new('samllanding',$lonid);
+    if ($cached) {
+        return $landing;
+    }
+    my $dom = &Apache::lonnet::host_domain($lonid);
+    if ($dom ne '') {
+        my $cachetime = 60*60*24;
+        my %domconfig =
+            &Apache::lonnet::get_dom('configuration',['login'],$dom);
+        if (ref($domconfig{'login'}) eq 'HASH') {
+            if (ref($domconfig{'login'}{'saml'}) eq 'HASH') {
+                if (ref($domconfig{'login'}{'saml'}{$lonid}) eq 'HASH') {
+                    $landing = 1;
+                }
+            }
+        }
+        return &do_cache_new('samllanding',$lonid,$landing,$cachetime);
+    }
+    return;
+}
+
 # ------------------------------------------------------------- Declutters URLs
 
 sub declutter {
@@ -13640,13 +13936,25 @@ sub get_dns {
     }
     while (%alldns) {
 	my ($dns) = sort { $b cmp $a } keys(%alldns);
-	my $ua=new LWP::UserAgent;
-        $ua->timeout(30);
-	my $request=new HTTP::Request('GET',"$alldns{$dns}://$dns$url");
-	my $response=$ua->request($request);
-        delete($alldns{$dns});
-	next if ($response->is_error());
-	my @content = split("\n",$response->content);
+        my @content;
+        if ($dns eq Sys::Hostname::FQDN::fqdn()) {
+            my $command = (split('/',$url))[3];
+            my ($dir,$file) = &parse_getdns_url($command,$url);
+            delete($alldns{$dns});
+            next if (($dir eq '') || ($file eq ''));
+            if (open(my $config,'<',"$dir/$file")) {
+                @content = <$config>;
+                close($config);
+            }
+        } else {
+	    my $ua=new LWP::UserAgent;
+            $ua->timeout(30);
+	    my $request=new HTTP::Request('GET',"$alldns{$dns}://$dns$url");
+	    my $response=$ua->request($request);
+            delete($alldns{$dns});
+	    next if ($response->is_error());
+	    @content = split("\n",$response->content);
+        }
         unless ($nocache) {
 	    &do_cache_new('dns',$url,\@content,30*24*60*60);
         }
@@ -13718,6 +14026,21 @@ sub fetch_dns_checksums {
     return \%checksums;
 }
 
+sub parse_getdns_url {
+    my ($command,$url) = @_;
+    my $dir = $perlvar{'lonTabDir'};
+    my $file;
+    if ($command eq 'hosts') {
+        $file = 'dns_hosts.tab';
+    } elsif ($command eq 'domain') {
+        $file = 'dns_domain.tab';
+    } elsif ($command eq 'checksums') {
+        my $version = (split('/',$url))[4];
+        $file = "dns_checksums/$version.tab",
+    }
+    return ($dir,$file);
+}
+
 # ------------------------------------------------------------ Read domain file
 {
     my $loaded;