--- loncom/auth/migrateuser.pm	2018/12/02 14:41:19	1.37
+++ loncom/auth/migrateuser.pm	2018/12/07 23:33:55	1.41
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # Starts a user off based of an existing token.
 #
-# $Id: migrateuser.pm,v 1.37 2018/12/02 14:41:19 raeburn Exp $
+# $Id: migrateuser.pm,v 1.41 2018/12/07 23:33:55 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -119,6 +119,48 @@ sub lti_check {
     return \%lti_env;
 }
 
+sub canhost {
+    my ($uname,$udom,$lonhost,$loncaparev) = @_;
+    my $canhost;
+    if (&Apache::lonnet::is_library($lonhost)) {
+        my @possdoms = &Apache::lonnet::current_machine_domains();
+        my %roleshash = &Apache::lonnet::get_my_roles($uname,$udom,'userroles','',['ca','aa'],\@possdoms);
+        if (keys(%roleshash)) {
+            foreach my $key (keys(%roleshash)) {
+                my $audom = (split(/:/,$key))[1];
+                if ((&Apache::lonnet::will_trust('othcoau',$udom,$audom)) &&
+                    (&Apache::lonnet::will_trust('coaurem',$audom,$udom))) {
+                    $canhost = 1;
+                    last;
+                }
+            }
+        }
+    }
+    unless ($canhost) {
+        my $uprimary_id = &Apache::lonnet::domain($udom,'primary');
+        my $uint_dom = &Apache::lonnet::internet_dom($uprimary_id);
+        my @intdoms;
+        my $internet_names = &Apache::lonnet::get_internet_names($lonhost);
+        if (ref($internet_names) eq 'ARRAY') {
+            @intdoms = @{$internet_names};
+        }
+        if ($uint_dom ne '' && grep(/^\Q$uint_dom\E$/,@intdoms)) {
+            $canhost = 1;
+        } else {
+            my $hostname = &Apache::lonnet::hostname($lonhost);
+            my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
+            my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
+            my %defdomdefaults = &Apache::lonnet::get_domain_defaults($serverhomedom);
+            my %udomdefaults = &Apache::lonnet::get_domain_defaults($udom);
+            $canhost =
+                &Apache::lonnet::can_host_session($udom,$lonhost,$loncaparev,
+                                                  $udomdefaults{'remotesessions'},
+                                                  $defdomdefaults{'hostedsessions'});
+        }
+    }
+    return $canhost;
+}
+
 sub ip_changed {
     my ($r,$udom,$camefrom,$idsref,$dataref) = @_;
     &Apache::loncommon::content_type($r,'text/html');
@@ -339,22 +381,20 @@ sub conlost_userhome {
         map { $conlost{$_} = 1; } split(/,/,$data{'conlost'});
     }
     if ($data{'loncfail'}) {
-        if ($is_balancer) {
-            if ($lonhost ne $data{'from_balancer'}) {
-                my ($is_balancer,$posshost,$setcookie,$offloadto,$dom_balancers) =
-                    &Apache::lonnet::check_loadbalancing($data{'username'},$data{'domain'});
-                if ($is_balancer) {
-                    if (ref($offloadto) eq 'HASH') {
-                        $data{'offloadto'} = '';
-                        foreach my $key (keys(%{$offloadto})) {
-                            if (ref($offloadto->{$key}) eq 'ARRAY') {
-                                $data{'offloadto'} .= $key.'='.join(',',@{$offloadto->{$key}}).'&';
-                            }
+        if ($lonhost ne $data{'from_balancer'}) {
+            my ($is_balancer,$posshost,$setcookie,$offloadto,$dom_balancers) =
+                &Apache::lonnet::check_loadbalancing($data{'username'},$data{'domain'});
+            if ($is_balancer) {
+                if (ref($offloadto) eq 'HASH') {
+                    $data{'offloadto'} = '';
+                    foreach my $key (keys(%{$offloadto})) {
+                        if (ref($offloadto->{$key}) eq 'ARRAY') {
+                            $data{'offloadto'} .= $key.'='.join(',',@{$offloadto->{$key}}).'&';
                         }
-                        $data{'offloadto'} =~ s/\&$//;
-                    } elsif (ref($offloadto) eq 'ARRAY') {
-                        $data{'offloadto'} = join(',',@{$offloadto});
                     }
+                    $data{'offloadto'} =~ s/\&$//;
+                } elsif (ref($offloadto) eq 'ARRAY') {
+                    $data{'offloadto'} = join(',',@{$offloadto});
                 }
             }
         }
@@ -446,7 +486,7 @@ sub conlost_userhome {
                 return $otherserver;
             } else {
                 #FIXME Contents of $data{'dom_balancers'} contains invalid hostID.
-            }  
+            }
         } else {
             if ($data{'loncfail'}) {
                 #FIXME Nowhere to go. 
@@ -577,11 +617,19 @@ sub handler {
         $udom=$data{'domain'};
     }
     if ($home eq 'no_host') { return &goto_login($r,$udom,\%data); }
-    if (&Apache::lonnet::hostname($home) eq '') { return &goto_login($r,$udom,\%data); } 
+    if (&Apache::lonnet::hostname($home) eq '') { return &goto_login($r,$udom,\%data); }
+
+    unless (grep(/^\Q$home\E$/,@ids)) {
+        my $lonhost = $r->dir_config('lonHostID');
+        my $loncaparev = $r->dir_config('lonVersion');
+        unless (&canhost($data{'username'},$data{'domain'},$lonhost,$loncaparev)) {
+            return &goto_login($r,$udom,\%data);
+        }
+    }
 
     my $rolemsg;
     if ($data{'role'}) {
-        $rolemsg = "role: $data{'role'}"; 
+        $rolemsg = "role: $data{'role'}";
     } else {
         $rolemsg = '(no role)';
     }