--- loncom/lonnet/perl/lonnet.pm	2020/07/19 15:12:04	1.1172.2.118.2.5
+++ 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.118.2.5 2020/07/19 15:12:04 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;
@@ -125,12 +127,13 @@ our @EXPORT = qw(%env);
 	$logid ++;
         my $now = time();
 	my $id=$now.'00000'.$$.'00000'.$logid;
+        my $ip = &get_requestor_ip();  
         my $logentry = {
                          $id => {
                                   'exe_uname' => $env{'user.name'},
                                   'exe_udom'  => $env{'user.domain'},
                                   'exe_time'  => $now,
-                                  'exe_ip'    => $ENV{'REMOTE_ADDR'},
+                                  'exe_ip'    => $ip,
                                   'delflag'   => $delflag,
                                   'logentry'  => $storehash,
                                   'uname'     => $uname,
@@ -688,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);
 
@@ -916,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 
@@ -961,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;
             }
         }
@@ -1082,6 +1090,21 @@ sub check_for_balancer_cookie {
     return ($otherserver,$cookie);
 }
 
+sub updatebalcookie {
+    my ($cookie,$balancer,$lastentry)=@_;
+    if ($cookie =~ /^($match_domain)\_($match_username)\_[a-f0-9]{32}$/) {
+        my ($udom,$uname) = ($1,$2);
+        my $uprimary_id = &domain($udom,'primary');
+        my $uintdom = &internet_dom($uprimary_id);
+        my $intdom = &internet_dom($balancer);
+        my $serverhomedom = &host_domain($balancer);
+        if (($uintdom ne '') && ($uintdom eq $intdom)) {
+            return &reply('updatebalcookie:'.&escape($cookie).':'.&escape($lastentry),$balancer);
+        }
+    }
+    return;
+}
+
 sub delbalcookie {
     my ($cookie,$balancer) =@_;
     if ($cookie =~ /^($match_domain)\_($match_username)\_[a-f0-9]{32}$/) {
@@ -1091,7 +1114,7 @@ sub delbalcookie {
         my $intdom = &internet_dom($balancer);
         my $serverhomedom = &host_domain($balancer);
         if (($uintdom ne '') && ($uintdom eq $intdom)) {
-            return &reply("delbalcookie:$cookie",$balancer);
+            return &reply('delbalcookie:'.&escape($cookie),$balancer);
         }
     }
 }
@@ -1360,6 +1383,15 @@ sub spare_can_host {
             $canhost = 0;
         }
     }
+    if ($canhost) {
+        if (ref($defdomdefaults{'offloadoth'}) eq 'HASH') {
+            if ($defdomdefaults{'offloadoth'}{$try_server}) {
+                unless (&shared_institution($udom,$try_server)) {
+                    $canhost = 0;
+                }
+            }
+        }
+    }
     if (($canhost) && ($uint_dom)) {
         my @intdoms;
         my $internet_names = &get_internet_names($try_server);
@@ -1578,7 +1610,7 @@ sub check_loadbalancing {
     if ($domneedscache) {
         &do_cache_new('loadbalancing',$domneedscache,$is_balancer,$cachetime);
     }
-    if ($is_balancer) {
+    if (($is_balancer) && ($caller ne 'switchserver')) {
         my $lowest_load = 30000;
         if (ref($offloadto) eq 'HASH') {
             if (ref($offloadto->{'primary'}) eq 'ARRAY') {
@@ -1618,9 +1650,9 @@ sub check_loadbalancing {
                 }
             }
         }
-        unless ($homeintdom) {
-            undef($setcookie);
-        }
+    }
+    if (($is_balancer) && (!$homeintdom)) {
+        undef($setcookie);
     }
     return ($is_balancer,$otherserver,$setcookie);
 }
@@ -1874,9 +1906,10 @@ sub get_dom {
     }
     if ($udom && $uhome && ($uhome ne 'no_host')) {
         my $rep;
-        if ($namespace =~ /^enc/) {
-            $rep=&reply("encrypt:egetdom:$udom:$namespace:$items",$uhome);
-        } else {
+        if (grep { $_ eq $uhome } &current_machine_ids()) {
+            # domain information is hosted on this machine
+            $rep = &LONCAPA::Lond::get_dom("getdom:$udom:$namespace:$items");
+        } else {        
             $rep=&reply("getdom:$udom:$namespace:$items",$uhome);
         }
         my %returnhash;
@@ -1922,11 +1955,7 @@ sub put_dom {
             $items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&';
         }
         $items=~s/\&$//;
-        if ($namespace =~ /^enc/) {
-            return &reply("encrypt:putdom:$udom:$namespace:$items",$uhome);
-        } else {
-            return &reply("putdom:$udom:$namespace:$items",$uhome);
-        }
+        return &reply("putdom:$udom:$namespace:$items",$uhome);
     } else {
         &logthis("put_dom failed - no homeserver and/or domain");
     }
@@ -2002,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';
         }
@@ -2409,6 +2438,9 @@ sub get_domain_defaults {
         if (ref($domconfig{'usersessions'}{'offloadnow'}) eq 'HASH') {
             $domdefaults{'offloadnow'} = $domconfig{'usersessions'}{'offloadnow'};
         }
+        if (ref($domconfig{'usersessions'}{'offloadoth'}) eq 'HASH') {
+            $domdefaults{'offloadoth'} = $domconfig{'usersessions'}{'offloadoth'};
+        }
     }
     if (ref($domconfig{'selfenrollment'}) eq 'HASH') {
         if (ref($domconfig{'selfenrollment'}{'admin'}) eq 'HASH') {
@@ -2457,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;
 }
@@ -2543,22 +2582,6 @@ sub get_passwdconf {
     return %passwdconf;
 }
 
-sub course_portal_url {
-    my ($cnum,$cdom) = @_;
-    my $chome = &homeserver($cnum,$cdom);
-    my $hostname = &hostname($chome);
-    my $protocol = $protocol{$chome};
-    $protocol = 'http' if ($protocol ne 'https');
-    my %domdefaults = &get_domain_defaults($cdom);
-    my $firsturl;
-    if ($domdefaults{'portal_def'}) {
-        $firsturl = $domdefaults{'portal_def'};
-    } else {
-        $firsturl = $protocol.'://'.$hostname;
-    }
-    return $firsturl;
-}
-
 # --------------------------------------------------- Assign a key to a student
 
 sub assign_access_key {
@@ -3110,12 +3133,7 @@ sub unsubscribe {
     } elsif (grep { $_ eq $home } &current_machine_ids()) {
         $answer = 'home';
     } else {
-        my $defdom = $perlvar{'lonDefDomain'};
-        if (&will_trust('content',$defdom,$udom)) {
-            $answer = reply("unsub:$fname",$home);
-        } else {
-            $answer = 'untrusted';
-        }
+        $answer = reply("unsub:$fname",$home);
     }
     return $answer;
 }
@@ -3451,14 +3469,6 @@ sub can_edit_resource {
                             $cfile =  '/adm/wrapper'.$resurl;
                         }
                     }
-                } elsif ($resurl =~ m{^/adm/wrapper/adm/$cdom/$cnum/\d+/ext\.tool$}) {
-                    $incourse = 1;
-                    if ($env{'form.forceedit'}) {
-                        $forceview = 1;
-                    } else {
-                        $forceedit = 1;
-                    }
-                    $cfile = $resurl;
                 } elsif ($resurl =~ m{^/?adm/viewclasslist$}) {
                     $incourse = 1;
                     if ($env{'form.forceedit'}) {
@@ -3483,14 +3493,6 @@ sub can_edit_resource {
                     $forceedit = 1;
                 }
                 $cfile = $resurl;
-            } elsif (($resurl =~ m{^/adm/wrapper/adm/$cdom/$cnum/\d+/ext\.tool$}) && ($env{'form.folderpath'} =~ /^supplemental/)) {
-                $incourse = 1;
-                if ($env{'form.forceedit'}) {
-                    $forceview = 1;
-                } else {
-                    $forceedit = 1;
-                }
-                $cfile = $resurl;
             } elsif (($resurl eq '/adm/extresedit') && ($symb || $env{'form.folderpath'})) {
                 $incourse = 1;
                 $forceview = 1;
@@ -3500,13 +3502,8 @@ sub can_edit_resource {
                     $cfile = &clutter($res);
                 } else {
                     $cfile = $env{'form.suppurl'};
-                    my $escfile = &unescape($cfile);
-                    if ($escfile =~ m{^/adm/$cdom/$cnum/\d+/ext\.tool$}) {
-                        $cfile = '/adm/wrapper'.$escfile;
-                    } else {
-                        $escfile =~ s{^http://}{};
-                        $cfile = &escape("/adm/wrapper/ext/$escfile");
-                    }
+                    $cfile =~ s{^http://}{};
+                    $cfile = '/adm/wrapper/ext/'.$cfile;
                 }
             } elsif ($resurl =~ m{^/?adm/viewclasslist$}) {
                 if ($env{'form.forceedit'}) {
@@ -3753,6 +3750,10 @@ sub clean_filename {
 # Replace all .\d. sequences with _\d. so they no longer look like version
 # numbers
     $fname=~s/\.(\d+)(?=\.)/_$1/g;
+# Replace three or more adjacent underscores with one for consistency
+# with loncfile::filename_check() so complete url can be extracted by
+# lonnet::decode_symb()
+    $fname=~s/_{3,}/_/g;
     return $fname;
 }
 
@@ -4614,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'};
             }
@@ -4723,7 +4747,11 @@ sub courseacclog {
                 if ($formitem =~ /^HWFILE(?:SIZE|TOOBIG)/) {
                     $what.=':'.$formitem.'='.$env{$key};
                 } elsif ($formitem !~ /^HWFILE(?:[^.]+)$/) {
-                    $what.=':'.$formitem.'='.$env{$key};
+                    if ($formitem eq 'proctorpassword') {
+                        $what.=':'.$formitem.'=' . '*' x length($env{$key});
+                    } else {
+                        $what.=':'.$formitem.'='.$env{$key};
+                    }
                 }
             }
         }
@@ -5479,10 +5507,9 @@ my %cachedtimes=();
 my $cachedtime='';
 
 sub load_all_first_access {
-    my ($uname,$udom,$ignorecache)=@_;
+    my ($uname,$udom)=@_;
     if (($cachedkey eq $uname.':'.$udom) &&
-        (abs($cachedtime-time)<5) && (!$env{'form.markaccess'}) &&
-        (!$ignorecache)) {
+        (abs($cachedtime-time)<5) && (!$env{'form.markaccess'})) {
         return;
     }
     $cachedtime=time;
@@ -5491,7 +5518,7 @@ sub load_all_first_access {
 }
 
 sub get_first_access {
-    my ($type,$argsymb,$argmap,$ignorecache)=@_;
+    my ($type,$argsymb,$argmap)=@_;
     my ($symb,$courseid,$udom,$uname)=&whichuser();
     if ($argsymb) { $symb=$argsymb; }
     my ($map,$id,$res)=&decode_symb($symb);
@@ -5503,7 +5530,7 @@ sub get_first_access {
     } else {
 	$res=$symb;
     }
-    &load_all_first_access($uname,$udom,$ignorecache);
+    &load_all_first_access($uname,$udom);
     return $cachedtimes{"$courseid\0$res"};
 }
 
@@ -5555,13 +5582,14 @@ sub checkout {
     my ($symb,$tuname,$tudom,$tcrsid)=@_;
     my $now=time;
     my $lonhost=$perlvar{'lonHostID'};
+    my $ip = &get_requestor_ip();
     my $infostr=&escape(
                  'CHECKOUTTOKEN&'.
                  $tuname.'&'.
                  $tudom.'&'.
                  $tcrsid.'&'.
                  $symb.'&'.
-                 $now.'&'.$ENV{'REMOTE_ADDR'});
+                 $now.'&'.$ip);
     my $token=&reply('tmpput:'.$infostr,$lonhost);
     if ($token=~/^error\:/) {
         &logthis("<font color=\"blue\">WARNING: ".
@@ -5575,7 +5603,7 @@ sub checkout {
 
     my %infohash=('resource.0.outtoken' => $token,
                   'resource.0.checkouttime' => $now,
-                  'resource.0.outremote' => $ENV{'REMOTE_ADDR'});
+                  'resource.0.outremote' => $ip);
 
     unless (&cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') {
        return '';
@@ -5606,6 +5634,7 @@ sub checkin {
     $lonhost=~tr/A-Z/a-z/;
     my $dtoken=$ta.'_'.&hostname($lonhost).'_'.$tb;
     $dtoken=~s/\W/\_/g;
+    my $ip = &get_requestor_ip();
     my ($dummy,$tuname,$tudom,$tcrsid,$symb,$chtim,$rmaddr)=
                  split(/\&/,&unescape(&reply('tmpget:'.$dtoken,$lonhost)));
 
@@ -5622,7 +5651,7 @@ sub checkin {
 
     my %infohash=('resource.0.intoken' => $token,
                   'resource.0.checkintime' => $now,
-                  'resource.0.inremote' => $ENV{'REMOTE_ADDR'});
+                  'resource.0.inremote' => $ip);
 
     unless (&cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') {
        return '';
@@ -5890,7 +5919,7 @@ sub tmpreset {
   if (!$domain) { $domain=$env{'user.domain'}; }
   if (!$stuname) { $stuname=$env{'user.name'}; }
   if ($domain eq 'public' && $stuname eq 'public') {
-      $stuname=$ENV{'REMOTE_ADDR'};
+      $stuname=&get_requestor_ip();
   }
   my $path=LONCAPA::tempdir();
   my %hash;
@@ -5927,7 +5956,7 @@ sub tmpstore {
   if (!$domain) { $domain=$env{'user.domain'}; }
   if (!$stuname) { $stuname=$env{'user.name'}; }
   if ($domain eq 'public' && $stuname eq 'public') {
-      $stuname=$ENV{'REMOTE_ADDR'};
+      $stuname=&get_requestor_ip();
   }
   my $now=time;
   my %hash;
@@ -5971,7 +6000,7 @@ sub tmprestore {
   if (!$domain) { $domain=$env{'user.domain'}; }
   if (!$stuname) { $stuname=$env{'user.name'}; }
   if ($domain eq 'public' && $stuname eq 'public') {
-      $stuname=$ENV{'REMOTE_ADDR'};
+      $stuname=&get_requestor_ip();
   }
   my %returnhash;
   $namespace=~s/\//\_/g;
@@ -6027,7 +6056,7 @@ sub store {
     }
     if (!$home) { $home=$env{'user.home'}; }
 
-    $$storehash{'ip'}=$ENV{'REMOTE_ADDR'};
+    $$storehash{'ip'}=&get_requestor_ip();
     $$storehash{'host'}=$perlvar{'lonHostID'};
 
     my $namevalue='';
@@ -6063,7 +6092,7 @@ sub cstore {
     }
     if (!$home) { $home=$env{'user.home'}; }
 
-    $$storehash{'ip'}=$ENV{'REMOTE_ADDR'};
+    $$storehash{'ip'}=&get_requestor_ip();
     $$storehash{'host'}=$perlvar{'lonHostID'};
 
     my $namevalue='';
@@ -6920,7 +6949,7 @@ sub currentdump {
    #
    my %returnhash=();
    #
-   if ($rep eq 'unknown_cmd') {
+   if ($rep eq "unknown_cmd") { 
        # an old lond will not know currentdump
        # Do a dump and make it look like a currentdump
        my @tmp = &dumpstore($courseid,$sdom,$sname,'.');
@@ -7055,7 +7084,8 @@ sub putstore {
        foreach my $key (keys(%{$storehash})) {
            $namevalue.=&escape($key).'='.&freeze_escape($storehash->{$key}).'&';
        }
-       $namevalue .= 'ip='.&escape($ENV{'REMOTE_ADDR'}).
+       my $ip = &get_requestor_ip();
+       $namevalue .= 'ip='.&escape($ip).
                      '&host='.&escape($perlvar{'lonHostID'}).
                      '&version='.$esc_v.
                      '&by='.&escape($env{'user.name'}.':'.$env{'user.domain'});
@@ -7279,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';
             }
         }
@@ -7836,7 +7866,7 @@ sub customaccess {
 # ------------------------------------------------- Check for a user privilege
 
 sub allowed {
-    my ($priv,$uri,$symb,$role,$clientip,$noblockcheck)=@_;
+    my ($priv,$uri,$symb,$role,$clientip,$noblockcheck,$ignorecache)=@_;
     my $ver_orguri=$uri;
     $uri=&deversion($uri);
     my $orguri=$uri;
@@ -7853,7 +7883,7 @@ sub allowed {
 
     if (defined($env{'allowed.'.$priv})) { return $env{'allowed.'.$priv}; }
 # Free bre access to adm and meta resources
-    if (((($uri=~/^adm\//) && ($uri !~ m{/(?:smppg|bulletinboard|ext\.tool)$})) 
+    if (((($uri=~/^adm\//) && ($uri !~ m{/(?:smppg|bulletinboard|viewclasslist|aboutme)$})) 
 	 || (($uri=~/\.meta$/) && ($uri!~m|^uploaded/|) )) 
 	&& ($priv eq 'bre')) {
 	return 'F';
@@ -7864,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';
@@ -7959,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;
                                 }
@@ -7972,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;
                                 }
@@ -8061,7 +8091,7 @@ sub allowed {
                 if ($noblockcheck) {
                     $thisallowed.=$value;
                 } else {
-                    my @blockers = &has_comm_blocking($priv,$symb,$uri);
+                    my @blockers = &has_comm_blocking($priv,$symb,$uri,$ignorecache);
                     if (@blockers > 0) {
                         $thisallowed = 'B';
                     } else {
@@ -8081,7 +8111,7 @@ sub allowed {
                         if ($noblockcheck) {
                             $thisallowed='F';
                         } else {
-                            my @blockers = &has_comm_blocking($priv,$symb,$refuri);
+                            my @blockers = &has_comm_blocking($priv,'',$refuri,'',1);
                             if (@blockers > 0) {
                                 $thisallowed = 'B';
                             } else {
@@ -8154,7 +8184,7 @@ sub allowed {
                    if ($noblockcheck) {
                        $thisallowed.=$value;
                    } else {
-                       my @blockers = &has_comm_blocking($priv,$symb,$uri);
+                       my @blockers = &has_comm_blocking($priv,$symb,$uri,$ignorecache);
                        if (@blockers > 0) {
                            $thisallowed = 'B';
                        } else {
@@ -8167,7 +8197,7 @@ sub allowed {
                $checkreferer=0;
            }
        }
-       
+
        if ($checkreferer) {
 	  my $refuri=$env{'httpref.'.$orguri};
             unless ($refuri) {
@@ -8196,7 +8226,7 @@ sub allowed {
                       if ($noblockcheck) {
                           $thisallowed.=$value;
                       } else {
-                          my @blockers = &has_comm_blocking($priv,$symb,$refuri);
+                          my @blockers = &has_comm_blocking($priv,'',$refuri,'',1);
                           if (@blockers > 0) {
                               $thisallowed = 'B';
                           } else {
@@ -8238,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;
@@ -8270,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 '.
@@ -8282,7 +8344,7 @@ sub allowed {
 	   }
        }
     }
-   
+
 #
 # Rest of the restrictions depend on selected course
 #
@@ -8440,22 +8502,27 @@ sub constructaccess {
 #
 # User for whom data are being temporarily cached.
 my $cacheduser='';
+# Course for which data are being temporarily cached.
+my $cachedcid='';
 # 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)) {
             return;
         }
     }
     $cachedlast=time;
     $cacheduser=$uname.':'.$udom;
-    %cachedblockers = &get_commblock_resources($blocks);
+    $cachedcid=$env{'request.course.id'};
+    %cachedblockers = &get_commblock_resources();
+    return;
 }
 
 sub get_comm_blocks {
@@ -8482,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};
@@ -8514,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';
@@ -8526,32 +8596,15 @@ 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);
-                                    @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);
-                                            if ($interval[1] eq 'map') {
-                                                last;
-                                            }
-                                        }
-                                    }
-                                }
+                            $mapname = &deversion($item);
+                            if (ref($navmap)) {
+                                my $timelimit = $navmap->get_mapparam(undef,$mapname,'0.interval');
+                                @interval = ($timelimit,'map');
                             }
                         }
                     }
-                    if ($interval[0] =~ /^(\d+)/) {
-                        my $timelimit = $1; 
+                    if ($interval[0] =~ /^\d+$/) {
                         my $first_access;
                         if ($type eq 'resource') {
                             $first_access=&get_first_access($interval[1],$item);
@@ -8561,13 +8614,40 @@ sub get_commblock_resources {
                             $first_access=&get_first_access($interval[1]);
                         }
                         if ($first_access) {
-                            my $timesup = $first_access+$timelimit;
+                            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) {
@@ -8593,17 +8673,27 @@ sub get_commblock_resources {
 }
 
 sub has_comm_blocking {
-    my ($priv,$symb,$uri,$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 $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);
+    } else {
+        &load_all_blockers($env{'user.name'},$env{'user.domain'});
+        %blockinfo = %cachedblockers;
+    }
+    return unless (keys(%blockinfo) > 0);
     my (%possibles,@symbs);
     if (!$symb) {
-        $symb = &symbread($uri,1,1,1,\%possibles);
+        $symb = &symbread($uri,1,1,1,\%possibles,$ignoresymbdb,$noenccheck);
     }
     if ($symb) {
         @symbs = ($symb);
@@ -8614,34 +8704,38 @@ sub has_comm_blocking {
     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;
-                if (($item eq $map) || ($item eq $symb)) {
-                    $noblock = 1;
-                    last;
+                unless ($blocked) {
+                    if (($item eq $map) || ($item eq $symb)) {
+                        $noblock = 1;
+                        last;
+                    }
                 }
             }
-            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$/,@blockers)) {
                             push(@blockers,$block);
                         }
                     }
                 }
-            }
-            if (ref($cachedblockers{$block}{'maps'}) eq 'HASH') {
-                if ($cachedblockers{$block}{'maps'}{$map}) {
-                    unless (grep(/^\Q$block\E$/,@blockers)) {
-                        push(@blockers,$block);
+                if (ref($blockinfo{$block}{'maps'}) eq 'HASH') {
+                    if ($blockinfo{$block}{'maps'}{$map}) {
+                        unless (grep(/^\Q$block\E$/,@blockers)) {
+                            push(@blockers,$block);
+                        }
                     }
                 }
             }
         }
     }
-    return if ($noblock);
-    return @blockers;
+    unless ($noblock) {
+        return @blockers;
+    }
+    return;
 }
 }
 
@@ -9039,6 +9133,25 @@ sub auto_validate_instcode {
     return ($outcome,$description,$defaultcredits);
 }
 
+sub auto_validate_inst_crosslist {
+    my ($cnum,$cdom,$instcode,$inst_xlist,$coowner) = @_;
+    my ($homeserver,$response);
+    if (($cdom =~ /^$match_domain$/) && ($cnum =~ /^$match_courseid$/)) {
+        $homeserver = &homeserver($cnum,$cdom);
+    }
+    if (!defined($homeserver)) {
+        if ($cdom =~ /^$match_domain$/) {
+            $homeserver = &domain($cdom,'primary');
+        }
+    }
+    unless (($homeserver eq '') || ($homeserver eq 'no_host')) {
+        $response=&reply('autovalidateinstcrosslist:'.$cdom.':'.
+                         &escape($instcode).':'.&escape($inst_xlist).':'.
+                         &escape($coowner),$homeserver);
+    }
+    return $response;
+}
+
 sub auto_create_password {
     my ($cnum,$cdom,$authparam,$udom) = @_;
     my ($homeserver,$response);
@@ -9310,6 +9423,38 @@ sub auto_validate_class_sec {
     return $response;
 }
 
+sub auto_instsec_reformat {
+    my ($cdom,$action,$instsecref) = @_;
+    return unless(($action eq 'clutter') || ($action eq 'declutter'));
+    my @homeservers;
+    if (defined(&domain($cdom,'primary'))) {
+        push(@homeservers,&domain($cdom,'primary'));
+    } else {
+        my %servers = &get_servers($cdom,'library');
+        foreach my $tryserver (keys(%servers)) {
+            if (!grep(/^\Q$tryserver\E$/,@homeservers)) {
+                push(@homeservers,$tryserver);
+            }
+        }
+    }
+    my $response;
+    my %reformatted = %{$instsecref};
+    foreach my $server (@homeservers) {
+        if (ref($instsecref) eq 'HASH') {
+            my $info = &freeze_escape($instsecref);
+            my $response=&reply('autoinstsecreformat:'.$cdom.':'.
+                                $action.':'.$info,$server);
+            next if ($response =~ /(con_lost|error|no_such_host|refused|unknown_command)/);
+            my @items = split(/&/,$response);
+            foreach my $item (@items) {
+                my ($key,$value) = split(/=/,$item);
+                $reformatted{&unescape($key)} = &thaw_unescape($value);
+            }
+        }
+    }
+    return %reformatted;
+}
+
 sub auto_validate_instclasses {
     my ($cdom,$cnum,$owners,$classesref) = @_;
     my ($homeserver,%validations);
@@ -9854,11 +9999,23 @@ sub autoupdate_coowners {
         if ($domdesign{$cdom.'.autoassign.co-owners'}) {
             my %coursehash = &coursedescription($cdom.'_'.$cnum);
             my $instcode = $coursehash{'internal.coursecode'};
+            my $xlists = $coursehash{'internal.crosslistings'};
             if ($instcode ne '') {
                 if (($start && $start <= $now) && ($end == 0) || ($end > $now)) {
                     unless ($coursehash{'internal.courseowner'} eq $uname.':'.$udom) {
                         my ($delcoowners,@newcoowners,$putresult,$delresult,$coowners);
                         my ($result,$desc) = &auto_validate_instcode($cnum,$cdom,$instcode,$uname.':'.$udom);
+                        unless ($result eq 'valid') {
+                            if ($xlists ne '') {
+                                foreach my $xlist (split(',',$xlists)) {
+                                    my ($inst_crosslist,$lcsec) = split(':',$xlist);
+                                    $result =
+                                        &auto_validate_inst_crosslist($cnum,$cdom,$instcode,
+                                                                      $inst_crosslist,$uname.':'.$udom);
+                                    last if ($result eq 'valid');
+                                }
+                            }
+                        }
                         if ($result eq 'valid') {
                             if ($coursehash{'internal.co-owners'}) {
                                 foreach my $coowner (split(',',$coursehash{'internal.co-owners'})) {
@@ -9871,18 +10028,16 @@ sub autoupdate_coowners {
                             } else {
                                 push(@newcoowners,$uname.':'.$udom);
                             }
-                        } else {
-                            if ($coursehash{'internal.co-owners'}) {
-                                foreach my $coowner (split(',',$coursehash{'internal.co-owners'})) {
-                                    unless ($coowner eq $uname.':'.$udom) {
-                                        push(@newcoowners,$coowner);
-                                    }
-                                }
-                                unless (@newcoowners > 0) {
-                                    $delcoowners = 1;
-                                    $coowners = '';
+                        } elsif ($coursehash{'internal.co-owners'}) {
+                            foreach my $coowner (split(',',$coursehash{'internal.co-owners'})) {
+                                unless ($coowner eq $uname.':'.$udom) {
+                                    push(@newcoowners,$coowner);
                                 }
                             }
+                            unless (@newcoowners > 0) {
+                                $delcoowners = 1;
+                                $coowners = '';
+                            }
                         }
                         if (@newcoowners || $delcoowners) {
                             &store_coowners($cdom,$cnum,$coursehash{'home'},
@@ -9956,13 +10111,14 @@ sub modifyuserauth {
              ' in domain '.$env{'request.role.domain'});  
     my $reply=&reply('encrypt:changeuserauth:'.$udom.':'.$uname.':'.$umode.':'.
 		     &escape($upass),$uhome);
+    my $ip = &get_requestor_ip();
     &log($env{'user.domain'},$env{'user.name'},$env{'user.home'},
         'Authentication changed for '.$udom.', '.$uname.', '.$umode.
-         '(Remote '.$ENV{'REMOTE_ADDR'}.'): '.$reply);
+         '(Remote '.$ip.'): '.$reply);
     &log($udom,,$uname,$uhome,
         'Authentication changed by '.$env{'user.domain'}.', '.
                                      $env{'user.name'}.', '.$umode.
-         '(Remote '.$ENV{'REMOTE_ADDR'}.'): '.$reply);
+         '(Remote '.$ip.'): '.$reply);
     unless ($reply eq 'ok') {
         &logthis('Authentication mode error: '.$reply);
 	return 'error: '.$reply;
@@ -10478,7 +10634,7 @@ sub store_userdata {
             if (($uhome eq '') || ($uhome eq 'no_host')) {
                 $result = 'error: no_host';
             } else {
-                $storehash->{'ip'} = $ENV{'REMOTE_ADDR'};
+                $storehash->{'ip'} = &get_requestor_ip();
                 $storehash->{'host'} = $perlvar{'lonHostID'};
 
                 my $namevalue='';
@@ -11303,7 +11459,7 @@ sub get_userresdata {
 #  Parameters:
 #     $name      - Course/user name.
 #     $domain    - Name of the domain the user/course is registered on.
-#     $type      - Type of thing $name is (must be 'course' or 'user')
+#     $type      - Type of thing $name is (must be 'course' or 'user'
 #     @which     - Array of names of resources desired.
 #  Returns:
 #     The value of the first reasource in @which that is found in the
@@ -11322,44 +11478,13 @@ sub resdata {
     }
     if (!ref($result)) { return $result; }    
     foreach my $item (@which) {
-        if (ref($item) eq 'ARRAY') {
-	    if (defined($result->{$item->[0]})) {
-	        return [$result->{$item->[0]},$item->[1]];
-	    }
-        }
+	if (defined($result->{$item->[0]})) {
+	    return [$result->{$item->[0]},$item->[1]];
+	}
     }
     return undef;
 }
 
-sub get_domain_ltitools {
-    my ($cdom) = @_;
-    my %ltitools;
-    my ($result,$cached)=&is_cached_new('ltitools',$cdom);
-    if (defined($cached)) {
-        if (ref($result) eq 'HASH') {
-            %ltitools = %{$result};
-        }
-    } else {
-        my %domconfig = &get_dom('configuration',['ltitools'],$cdom);
-        if (ref($domconfig{'ltitools'}) eq 'HASH') {
-            %ltitools = %{$domconfig{'ltitools'}};
-            my %encdomconfig = &get_dom('encconfig',['ltitools'],$cdom);
-            if (ref($encdomconfig{'ltitools'}) eq 'HASH') {
-                foreach my $id (keys(%ltitools)) {
-                    if (ref($encdomconfig{'ltitools'}{$id}) eq 'HASH') {
-                        foreach my $item ('key','secret') {
-                            $ltitools{$id}{$item} = $encdomconfig{'ltitools'}{$id}{$item};
-                        }
-                    }
-                }
-            }
-        }
-        my $cachetime = 24*60*60;
-        &do_cache_new('ltitools',$cdom,\%ltitools,$cachetime);
-    }
-    return %ltitools;
-}
-
 sub get_numsuppfiles {
     my ($cnum,$cdom,$ignorecache)=@_;
     my $hashid=$cnum.':'.$cdom;
@@ -11440,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})) {
@@ -11815,7 +11940,7 @@ sub metadata {
     # if it is a non metadata possible uri return quickly
     if (($uri eq '') || 
 	(($uri =~ m|^/*adm/|) && 
-	     ($uri !~ m|^adm/includes|) && ($uri !~ m{/(smppg|bulletinboard|ext\.tool)$})) ||
+	     ($uri !~ m|^adm/includes|) && ($uri !~ m{/(smppg|bulletinboard)$})) ||
         ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ m{^/*uploaded/.+\.sequence$})) {
 	return undef;
     }
@@ -12511,13 +12636,16 @@ sub deversion {
 # ------------------------------------------------------ Return symb list entry
 
 sub symbread {
-    my ($thisfn,$donotrecurse,$ignorecachednull,$checkforblock,$possibles)=@_;
+    my ($thisfn,$donotrecurse,$ignorecachednull,$checkforblock,$possibles,
+        $ignoresymbdb,$noenccheck)=@_;
     my $cache_str='request.symbread.cached.'.$thisfn;
     if (defined($env{$cache_str})) {
-        if ($ignorecachednull) {
-            return $env{$cache_str} unless ($env{$cache_str} eq '');
-        } else {
-            return $env{$cache_str};
+        unless (ref($possibles) eq 'HASH') {
+            if ($ignorecachednull) {
+                return $env{$cache_str} unless ($env{$cache_str} eq '');
+            } else {
+                return $env{$cache_str};
+            }
         }
     }
 # no filename provided? try from environment
@@ -12546,10 +12674,18 @@ sub symbread {
 	if ($targetfn =~ m|^adm/wrapper/(ext/.*)|) {
 	    $targetfn=$1;
 	}
-        if (tie(%hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db',
-                      &GDBM_READER(),0640)) {
-	    $syval=$hash{$targetfn};
-            untie(%hash);
+        unless ($ignoresymbdb) {
+            if (tie(%hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db',
+                          &GDBM_READER(),0640)) {
+	        $syval=$hash{$targetfn};
+                untie(%hash);
+            }
+            if ($syval && $checkforblock) {
+                my @blockers = &has_comm_blocking('bre',$syval,$thisfn,$ignoresymbdb,$noenccheck);
+                if (@blockers) {
+                    $syval='';
+                }
+            }
         }
 # ---------------------------------------------------------- There was an entry
         if ($syval) {
@@ -12582,13 +12718,18 @@ sub symbread {
 		     $syval=&encode_symb($bighash{'map_id_'.$mapid},
 						    $resid,$thisfn);
                      if (ref($possibles) eq 'HASH') {
-                         $possibles->{$syval} = 1;
+                         unless ($bighash{'randomout_'.$ids} || $env{'request.role.adv'}) {
+                             $possibles->{$syval} = 1;
+                         }
                      }
                      if ($checkforblock) {
-                         my @blockers = &has_comm_blocking('bre',$syval,$bighash{'src_'.$ids});
-                         if (@blockers) {
-                             $syval = '';
-                             return;
+                         unless ($bighash{'randomout_'.$ids} || $env{'request.role.adv'}) {
+                             my @blockers = &has_comm_blocking('bre',$syval,$bighash{'src_'.$ids},'',$noenccheck);
+                             if (@blockers) {
+                                 $syval = '';
+                                 untie(%bighash);
+                                 return $env{$cache_str}='';
+                             }
                          }
                      }
                  } elsif ((!$donotrecurse) || ($checkforblock) || (ref($possibles) eq 'HASH')) {
@@ -12607,12 +12748,13 @@ sub symbread {
                              if ($bighash{'map_type_'.$mapid} ne 'page') {
                                  my $poss_syval=&encode_symb($bighash{'map_id_'.$mapid},
                                                              $resid,$thisfn);
-                                 if (ref($possibles) eq 'HASH') {
-                                     $possibles->{$syval} = 1;
-                                 }
+                                 next if ($bighash{'randomout_'.$id} && !$env{'request.role.adv'});
+                                 next unless (($noenccheck) || ($bighash{'encrypted_'.$id} eq $env{'request.enc'}));
                                  if ($checkforblock) {
-                                     my @blockers = &has_comm_blocking('bre',$poss_syval,$file);
-                                     unless (@blockers > 0) {
+                                     my @blockers = &has_comm_blocking('bre',$poss_syval,$file,'',$noenccheck);
+                                     if (@blockers > 0) {
+                                         $syval = '';
+                                     } else {
                                          $syval = $poss_syval;
                                          $realpossible++;
                                      }
@@ -12620,6 +12762,11 @@ sub symbread {
                                      $syval = $poss_syval;
                                      $realpossible++;
                                  }
+                                 if ($syval) {
+                                     if (ref($possibles) eq 'HASH') {
+                                         $possibles->{$syval} = 1;
+                                     }
+                                 }
                              }
 			 }
                      }
@@ -13339,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;
 }
@@ -13361,9 +13513,12 @@ sub default_login_domain {
 }
 
 sub shared_institution {
-    my ($dom) = @_;
+    my ($dom,$lonhost) = @_;
+    if ($lonhost eq '') {
+        $lonhost = $perlvar{'lonHostID'};
+    }
     my $same_intdom;
-    my $hostintdom = &internet_dom($perlvar{'lonHostID'});
+    my $hostintdom = &internet_dom($lonhost);
     if ($hostintdom ne '') {
         my %iphost = &get_iphost();
         my $primary_id = &domain($dom,'primary');
@@ -13420,6 +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)) {
+        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 {
@@ -13470,8 +13849,6 @@ sub clutter {
 #		&logthis("Got a blank emb style");
 	    }
 	}
-    } elsif ($thisfn =~ m{^/adm/$match_domain/$match_courseid/\d+/ext\.tool$}) {
-        $thisfn='/adm/wrapper'.$thisfn;
     }
     return $thisfn;
 }
@@ -13559,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);
         }
@@ -13637,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;