--- loncom/lonnet/perl/lonnet.pm	2017/05/25 23:55:42	1.1346
+++ loncom/lonnet/perl/lonnet.pm	2017/08/07 20:22:54	1.1347
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1346 2017/05/25 23:55:42 raeburn Exp $
+# $Id: lonnet.pm,v 1.1347 2017/08/07 20:22:54 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -1598,6 +1598,146 @@ sub internet_dom_servers {
     return %uniqservers;
 }
 
+sub notcallable {
+    my ($cmdtype,$calldom) = @_;
+    if (&domain($calldom) eq '') {
+        return 1;
+    }
+    unless ($cmdtype =~ /^(content|shared|enroll|coaurem|domroles|catalog|reqcrs|msg)$/) {
+        return 1;
+    }
+    my @machinedoms = &current_machine_domains();
+    if (grep(/^\Q$calldom\E$/,@machinedoms)) {
+        return;
+    }
+    my $reject;
+    my $intdom = &internet_dom($perlvar{'lonHostID'});
+    if ($intdom eq '') {
+        return 1;
+    }
+    my $callprimary = &domain($calldom,'primary');
+    my $intcalldom = &Apache::lonnet::internet_dom($callprimary);
+    unless ($intdom eq $intcalldom) {
+        my ($trustconfig,$cached)=&Apache::lonnet::is_cached_new('trust',$calldom);
+        unless (defined($cached)) {
+            my %domconfig = &Apache::lonnet::get_dom('configuration',['trust'],$calldom);
+            &Apache::lonnet::do_cache_new('trust',$calldom,$domconfig{'trust'},3600);
+            $trustconfig = $domconfig{'trust'};
+        }
+        if (ref($trustconfig)) {
+            if (ref($trustconfig->{$cmdtype}) eq 'HASH') {
+                if (ref($trustconfig->{$cmdtype}->{'exc'}) eq 'ARRAY') {
+                    if (grep(/^\Q$intdom\E$/,@{$trustconfig->{$cmdtype}->{'exc'}})) {
+                        $reject = 1;
+                    }
+                }
+                if (ref($trustconfig->{$cmdtype}->{'inc'}) eq 'ARRAY') {
+                    if (grep(/^\Q$intdom\E$/,@{$trustconfig->{$cmdtype}->{'inc'}})) {
+                        $reject = 0;
+                    } else {
+                        $reject = 1;
+                    }
+                }
+            }
+        }
+    }
+    return $reject;
+}
+
+sub trusted_domains {
+    my ($cmdtype,$calldom) = @_;
+    my (%trusted,%untrusted);
+    if (&domain($calldom) eq '') {
+        return (\%trusted,\%untrusted);
+    }
+    unless ($cmdtype =~ /^(content|shared|enroll|coaurem|domroles|catalog|reqcrs|msg)$/) {
+        return (\%trusted,\%untrusted);
+    }
+    my $callprimary = &domain($calldom,'primary');
+    my $intcalldom = &Apache::lonnet::internet_dom($callprimary);
+    if ($intcalldom eq '') {
+        return (\%trusted,\%untrusted);
+    }
+
+    my ($trustconfig,$cached)=&Apache::lonnet::is_cached_new('trust',$calldom);
+    unless (defined($cached)) {
+        my %domconfig = &Apache::lonnet::get_dom('configuration',['trust'],$calldom);
+        &Apache::lonnet::do_cache_new('trust',$calldom,$domconfig{'trust'},3600);
+        $trustconfig = $domconfig{'trust'};
+    }
+    if (ref($trustconfig)) {
+        my (%possexc,%possinc,@allexc,@allinc); 
+        if (ref($trustconfig->{$cmdtype}) eq 'HASH') {
+            if (ref($trustconfig->{$cmdtype}->{'exc'}) eq 'ARRAY') {
+                map { $possexc{$_} = 1; } @{$trustconfig->{$cmdtype}->{'exc'}}; 
+            }
+            if (ref($trustconfig->{$cmdtype}->{'inc'}) eq 'ARRAY') {
+                map { $possinc{$_} = 1; } @{$trustconfig->{$cmdtype}->{'inc'}};
+            }
+        }
+        if (keys(%possexc)) {
+            if (keys(%possinc)) {
+                foreach my $key (sort(keys(%possexc))) {
+                    next if ($key eq $intcalldom);
+                    unless ($possinc{$key}) {
+                        push(@allexc,$key);
+                    }
+                }
+            } else {
+                @allexc = sort(keys(%possexc));
+            }
+        }
+        if (keys(%possinc)) {
+            $possinc{$intcalldom} = 1;
+            @allinc = sort(keys(%possinc));
+        }
+        if ((@allexc > 0) || (@allinc > 0)) {
+            my %doms_by_intdom;
+            my %allintdoms = &all_host_intdom();
+            my %alldoms = &all_host_domain();
+            foreach my $key (%allintdoms) {
+                if (ref($doms_by_intdom{$allintdoms{$key}}) eq 'ARRAY') {
+                    unless (grep(/^\Q$alldoms{$key}\E$/,@{$doms_by_intdom{$allintdoms{$key}}})) {
+                        push(@{$doms_by_intdom{$allintdoms{$key}}},$alldoms{$key});
+                    }
+                } else {
+                    $doms_by_intdom{$allintdoms{$key}} = [$alldoms{$key}]; 
+                }
+            }
+            foreach my $exc (@allexc) {
+                if (ref($doms_by_intdom{$exc}) eq 'ARRAY') {
+                    map { $untrusted{$_}; } @{$doms_by_intdom{$exc}};
+                }
+            }
+            foreach my $inc (@allinc) {
+                if (ref($doms_by_intdom{$inc}) eq 'ARRAY') {
+                    map { $trusted{$_}; } @{$doms_by_intdom{$inc}};
+                }
+            }
+        }
+    }
+    return(\%trusted,\%untrusted);
+}
+
+sub will_trust {
+    my ($cmdtype,$domain,$possdom) = @_;
+    return 1 if ($domain eq $possdom);
+    my ($trustedref,$untrustedref) = &trusted_domains($cmdtype,$possdom);
+    my $willtrust; 
+    if ((ref($trustedref) eq 'ARRAY') && (@{$trustedref} > 0)) {
+        if (grep(/^\Q$domain\E$/,@{$trustedref})) {
+            $willtrust = 1;
+        }
+    } elsif ((ref($untrustedref) eq 'ARRAY') && (@{$untrustedref} > 0)) {
+        unless (grep(/^\Q$domain\E$/,@{$untrustedref})) {
+            $willtrust = 1;
+        }
+    } else {
+        $willtrust = 1;
+    }
+    return $willtrust;
+}
+
 # ---------------------- Find the homebase for a user from domain's lib servers
 
 my %homecache;