--- loncom/lonnet/perl/lonnet.pm	2019/07/23 13:59:01	1.1413
+++ loncom/lonnet/perl/lonnet.pm	2019/07/25 20:23:59	1.1414
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1413 2019/07/23 13:59:01 raeburn Exp $
+# $Id: lonnet.pm,v 1.1414 2019/07/25 20:23:59 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -14067,6 +14067,27 @@ sub default_login_domain {
     return $domain;
 }
 
+sub shared_institution {
+    my ($dom) = @_;
+    my $same_intdom;
+    my $hostintdom = &internet_dom($perlvar{'lonHostID'});
+    if ($hostintdom ne '') {
+        my %iphost = &get_iphost();
+        my $primary_id = &domain($dom,'primary');
+        my $primary_ip = &get_host_ip($primary_id);
+        if (ref($iphost{$primary_ip}) eq 'ARRAY') {
+            foreach my $id (@{$iphost{$primary_ip}}) {
+                my $intdom = &internet_dom($id);
+                if ($intdom eq $hostintdom) {
+                    $same_intdom = 1;
+                    last;
+                }
+            }
+        }
+    }
+    return $same_intdom;
+}
+
 sub uses_sts {
     my ($ignore_cache) = @_;
     my $lonhost = $perlvar{'lonHostID'};