--- loncom/lonnet/perl/lonnet.pm	2018/11/25 02:27:04	1.1390
+++ loncom/lonnet/perl/lonnet.pm	2018/12/08 17:38:47	1.1395
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1390 2018/11/25 02:27:04 raeburn Exp $
+# $Id: lonnet.pm,v 1.1395 2018/12/08 17:38:47 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -711,6 +711,7 @@ sub check_for_valid_session {
 
     if (!defined($disk_env{'user.name'})
 	|| !defined($disk_env{'user.domain'})) {
+        untie(%disk_env);
 	return undef;
     }
 
@@ -723,6 +724,7 @@ sub check_for_valid_session {
             $userhashref->{'ltiuri'} = $disk_env{'request.lti.uri'};
         }
     }
+    untie(%disk_env);
 
     return $handle;
 }
@@ -747,6 +749,37 @@ sub timed_flock {
     }
 }
 
+sub get_sessionfile_vars {
+    my ($handle,$lonidsdir,$storearr) = @_;
+    my %returnhash;
+    unless (ref($storearr) eq 'ARRAY') {
+        return %returnhash;
+    }
+    if (-l "$lonidsdir/$handle.id") {
+        my $link = readlink("$lonidsdir/$handle.id");
+        if ((-e $link) && ($link =~ m{^\Q$lonidsdir\E/(.+)\.id$})) {
+            $handle = $1;
+        }
+    }
+    if ((-e "$lonidsdir/$handle.id") &&
+        ($handle =~ /^($match_username)\_\d+\_($match_domain)\_(.+)$/)) {
+        my ($possuname,$possudom,$possuhome) = ($1,$2,$3);
+        if ((&domain($possudom) ne '') && (&homeserver($possuname,$possudom) eq $possuhome)) {
+            if (open(my $idf,'+<',"$lonidsdir/$handle.id")) {
+                flock($idf,LOCK_SH);
+                if (tie(my %disk_env,'GDBM_File',"$lonidsdir/$handle.id",
+                        &GDBM_READER(),0640)) {
+                    foreach my $item (@{$storearr}) {
+                        $returnhash{$item} = $disk_env{$item};
+                    }
+                    untie(%disk_env);
+                }
+            }
+        }
+    }
+    return %returnhash;
+}
+
 # ---------------------------------------------------------- Append Environment
 
 sub appenv {
@@ -1435,7 +1468,7 @@ sub get_lonbalancer_config {
 sub check_loadbalancing {
     my ($uname,$udom,$caller) = @_;
     my ($is_balancer,$currtargets,$currrules,$dom_in_use,$homeintdom,
-        $rule_in_effect,$offloadto,$otherserver,$setcookie);
+        $rule_in_effect,$offloadto,$otherserver,$setcookie,$dom_balancers);
     my $lonhost = $perlvar{'lonHostID'};
     my @hosts = &current_machine_ids();
     my $uprimary_id = &Apache::lonnet::domain($udom,'primary');
@@ -1462,7 +1495,7 @@ sub check_loadbalancing {
         }
     }
     if (ref($result) eq 'HASH') {
-        ($is_balancer,$currtargets,$currrules,$setcookie) =
+        ($is_balancer,$currtargets,$currrules,$setcookie,$dom_balancers) =
             &check_balancer_result($result,@hosts);
         if ($is_balancer) {
             if (ref($currrules) eq 'HASH') {
@@ -1523,7 +1556,7 @@ sub check_loadbalancing {
             }
         }
         if (ref($result) eq 'HASH') {
-            ($is_balancer,$currtargets,$currrules,$setcookie) =
+            ($is_balancer,$currtargets,$currrules,$setcookie,$dom_balancers) =
                 &check_balancer_result($result,@hosts);
             if ($is_balancer) {
                 if (ref($currrules) eq 'HASH') {
@@ -1599,12 +1632,12 @@ sub check_loadbalancing {
             undef($setcookie);
         }
     }
-    return ($is_balancer,$otherserver,$setcookie);
+    return ($is_balancer,$otherserver,$setcookie,$offloadto,$dom_balancers);
 }
 
 sub check_balancer_result {
     my ($result,@hosts) = @_;
-    my ($is_balancer,$currtargets,$currrules,$setcookie);
+    my ($is_balancer,$currtargets,$currrules,$setcookie,$dom_balancers);
     if (ref($result) eq 'HASH') {
         if ($result->{'lonhost'} ne '') {
             my $currbalancer = $result->{'lonhost'};
@@ -1613,20 +1646,24 @@ sub check_balancer_result {
                 $currtargets = $result->{'targets'};
                 $currrules = $result->{'rules'};
             }
+            $dom_balancers = $currbalancer;
         } else {
-            foreach my $key (keys(%{$result})) {
-                if (($key ne '') && (grep(/^\Q$key\E$/,@hosts)) &&
-                    (ref($result->{$key}) eq 'HASH')) {
-                    $is_balancer = 1;
-                    $currrules = $result->{$key}{'rules'};
-                    $currtargets = $result->{$key}{'targets'};
-                    $setcookie = $result->{$key}{'cookie'};
-                    last;
+            if (keys(%{$result})) {
+                foreach my $key (keys(%{$result})) {
+                    if (($key ne '') && (grep(/^\Q$key\E$/,@hosts)) &&
+                        (ref($result->{$key}) eq 'HASH')) {
+                        $is_balancer = 1;
+                        $currrules = $result->{$key}{'rules'};
+                        $currtargets = $result->{$key}{'targets'};
+                        $setcookie = $result->{$key}{'cookie'};
+                        last;
+                    }
                 }
+                $dom_balancers = join(',',sort(keys(%{$result})));
             }
         }
     }
-    return ($is_balancer,$currtargets,$currrules,$setcookie);
+    return ($is_balancer,$currtargets,$currrules,$setcookie,$dom_balancers);
 }
 
 sub get_loadbalancer_targets {
@@ -1704,7 +1741,7 @@ sub trusted_domains {
     if (&domain($calldom) eq '') {
         return ($trusted,$untrusted);
     }
-    unless ($cmdtype =~ /^(content|shared|enroll|coaurem|domroles|catalog|reqcrs|msg)$/) {
+    unless ($cmdtype =~ /^(content|shared|enroll|coaurem|othcoau|domroles|catalog|reqcrs|msg)$/) {
         return ($trusted,$untrusted);
     }
     my $callprimary = &domain($calldom,'primary');
@@ -1726,6 +1763,7 @@ sub trusted_domains {
                 map { $possexc{$_} = 1; } @{$trustconfig->{$cmdtype}->{'exc'}}; 
             }
             if (ref($trustconfig->{$cmdtype}->{'inc'}) eq 'ARRAY') {
+                $possinc{$intcalldom} = 1;
                 map { $possinc{$_} = 1; } @{$trustconfig->{$cmdtype}->{'inc'}};
             }
         }
@@ -1760,12 +1798,12 @@ sub trusted_domains {
             }
             foreach my $exc (@allexc) {
                 if (ref($doms_by_intdom{$exc}) eq 'ARRAY') {
-                    $untrusted = $doms_by_intdom{$exc};
+                    push(@{$untrusted},@{$doms_by_intdom{$exc}});
                 }
             }
             foreach my $inc (@allinc) {
                 if (ref($doms_by_intdom{$inc}) eq 'ARRAY') {
-                    $trusted = $doms_by_intdom{$inc};
+                    push(@{$trusted},@{$doms_by_intdom{$inc}});
                 }
             }
         }
@@ -5318,8 +5356,8 @@ sub set_first_access {
     my $firstaccess=&get_first_access($type,$symb,$map);
     if ($firstaccess) {
         &logthis("First access time already set ($firstaccess) when attempting ".
-                 "to set new value (type: $type, extent: $res) for $uname:$udom ". 
-                 "in $courseid"); 
+                 "to set new value (type: $type, extent: $res) for $uname:$udom ".
+                 "in $courseid");
         return 'already_set';
     } else {
         my $start = time;