--- loncom/auth/migrateuser.pm	2018/11/24 16:19:04	1.35
+++ loncom/auth/migrateuser.pm	2018/11/28 05:05:30	1.36
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # Starts a user off based of an existing token.
 #
-# $Id: migrateuser.pm,v 1.35 2018/11/24 16:19:04 raeburn Exp $
+# $Id: migrateuser.pm,v 1.36 2018/11/28 05:05:30 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -301,6 +301,7 @@ sub logout {
         %user_info=('ip'       => $ENV{'REMOTE_ADDR'},
                     'domain'   => $data->{'domain'},
                     'username' => $data->{'username'},
+                    'home'     => $data->{'home'},
                     'role'     => $data->{'role'},
                     'origurl'  => $data->{'origurl'},
                     'symb'     => $data->{'symb'},
@@ -319,6 +320,98 @@ sub logout {
     return;
 }
 
+sub conlost_userhome {
+    my ($r,$idsref,$dataref) = @_;
+    return unless ((ref($idsref) eq 'ARRAY') && (ref($dataref) eq 'HASH'));
+    my @ids = @{$idsref};
+    my %data = %{$dataref};
+    my (%conlost,%posstargets);
+    my $lonhost = $r->dir_config('lonHostID');
+    $conlost{$lonhost} = 1;
+    if ($data{'conlost'} ne '') {
+        map { $conlost{$_} = 1; } split(/,/,$data{'conlost'});
+    }
+    my ($lowest_load,$otherserver);
+    $lowest_load = 30000;
+    if ($data{'offloadto'} =~ /\&/) {
+        my @items = split(/\&/,$data{'offloadto'});
+        foreach my $item (@items) {
+            my ($type,$targets) = split(/\=/,$item);
+            @{$posstargets{$type}} = split(/,/,$targets);
+        }
+    } elsif ($data{'offloadto'} =~ /=/) {
+        my ($type,$targets) = split(/\=/,$data{'offloadto'});
+        @{$posstargets{$type}} = split(/,/,$targets);
+    } else {
+        @{$posstargets{'default'}} = split(/,/,$data{'offloadto'});
+    }
+    if (ref($posstargets{'primary'}) eq 'ARRAY') {
+        foreach my $try_server (@{$posstargets{'primary'}}) {
+            next if (grep(/^\Q$try_server\E$/,@ids));
+            next if ($conlost{$try_server});
+            ($otherserver,$lowest_load) =
+                &Apache::lonnet::compare_server_load($try_server,
+                                                     $otherserver,
+                                                     $lowest_load);
+        }
+    }
+    my $found_server = ($otherserver ne '' && $lowest_load < 100);
+    if (!$found_server) {
+        if (ref($posstargets{'default'}) eq 'ARRAY') {
+            foreach my $try_server (@{$posstargets{'default'}}) {
+                ($otherserver,$lowest_load) =
+                &Apache::lonnet::compare_server_load($try_server,
+                                                     $otherserver,
+                                                     $lowest_load);
+            }
+        }
+    }
+    if ($otherserver ne '') {
+        my $switchto = &Apache::lonnet::hostname($otherserver);
+        if ($switchto ne '') {
+            my $protocol = $Apache::lonnet::protocol{$switchto};
+            $protocol = 'http' if ($protocol ne 'https');
+            my $url = $protocol.'://'.$switchto.'/adm/login?'.
+                                    'domain='.$env{'user.domain'}.
+                                    '&amp;username='.$env{'user.name'};
+            $data{'conlost'} = join(',',sort(keys(%conlost)));
+            $data{'server'} = $lonhost;
+            if (grep(/^\Q$otherserver\E$/,split(/,/,$data{'dom_balancers'}))) {
+                $data{'noloadbalance'} = $otherserver; 
+            }
+            my $token = &Apache::lonnet::tmpput(\%data,$otherserver);
+            $url .= '&amp;token='.$token;
+            $r->send_http_header;
+            $r->print(
+                &Apache::loncommon::start_page('Switching Server ...',undef,
+                                               {'redirect'       => [0.1,$url]}).
+                                                &Apache::loncommon::end_page());
+            return $otherserver;
+        }
+    }
+}
+
+sub log_switch {
+    my ($r,$data,$lti_env) = @_;
+    my $lonhost = $r->dir_config('lonHostID');
+    return unless ((ref($data) eq 'HASH') && (ref($lti_env) eq 'HASH'));
+    my $now = time;
+    my %temp=('switchserver' => $now.':'.$lonhost,$data->{'role'});
+    &Apache::lonnet::put('email_status',\%temp);
+    my $logmsg = "Switch Server to $lonhost";
+    if ($data->{'role'}) {
+        $logmsg .= " with role: ".$data->{'role'};
+    } elsif (($lti_env->{'reqcrs'}) && ($lti_env->{'reqrole'} eq 'cc')) {
+        $logmsg .= " to create new LTI course";
+    } elsif ($lti_env->{'selfenrollrole'}) {
+        $logmsg .= " to selfenroll with role: ".$lti_env->{'selfenrollrole'};
+    } else {
+        $logmsg .= " (no role)";
+    }
+    $logmsg .= ' '.$ENV{'REMOTE_ADDR'};
+    &Apache::lonnet::log($data->{'domain'},$data->{'username'},$data->{'home'},$logmsg);
+}
+
 sub flush_course_logs {
     &Apache::lonnet::flushcourselogs();
     return OK;
@@ -349,13 +442,41 @@ sub handler {
 	return &ip_changed($r,$data{'domain'},$data{'server'},\%data);
     }
 
-    &Apache::lonnet::logthis("Allowing access for $data{'username'}:$data{'domain'} to $data{'role'}");
     my $home=&Apache::lonnet::homeserver($data{'username'},$data{'domain'});
+    if ($home eq 'no_host') {
+        if (($data{'home'} ne '') && (&Apache::lonnet::hostname($data{'home'}))) {
+            &Apache::lonnet::reconlonc($data{'home'});
+            $home=&Apache::lonnet::homeserver($data{'username'},$data{'domain'});
+            if ($home eq 'no_host') {
+                my @ids=&Apache::lonnet::current_machine_ids();
+                unless (grep(/^\Q$data{'home'}\E$/,@ids)) {
+                    if (&Apache::lonnet::reply('ping',$data{'home'}) eq 'con_lost') {
+                        my $otherserver = &conlost_userhome($r,\@ids,\%data);
+                        if ($otherserver ne '') {
+                            &Apache::lonnet::logthis("No connection to home server ($data{'home'}) for $data{'username'}:$data{'domain'}. Switching to $otherserver");
+                            return OK;
+                        }
+                    }
+                }
+            }
+        }
+    }
+
     my $udom;
     if (&Apache::lonnet::domain($data{'domain'})) {
         $udom=$data{'domain'};
     }
-    if ($home =~ /(con_lost|no_such_host)/) { return &goto_login($r,$udom,\%data); }
+    if ($home eq 'no_host') { return &goto_login($r,$udom,\%data); }
+    if (&Apache::lonnet::hostname($home) eq '') { return &goto_login($r,$udom,\%data); } 
+
+    my $rolemsg;
+    if ($data{'role'}) {
+        $rolemsg = "role: $data{'role'}"; 
+    } else {
+        $rolemsg = '(no role)';
+    }
+
+    &Apache::lonnet::logthis("Allowing access for $data{'username'}:$data{'domain'} $rolemsg");
 
     my $sso_env = &sso_check(\%data);
     my $lti_env = &lti_check(\%data);
@@ -378,6 +499,16 @@ sub handler {
         $form{'noloadbalance'} = $data{'noloadbalance'};
     }
 
+    if (($data{'conlost'}) && ($data{'server'})) {
+        my @conlosts = split(/,/,$data{'conlost'});
+        my $switchfrom = $data{'server'};
+        if (@conlosts) {
+            if (grep(/^\Q$switchfrom\E$/,@conlosts)) {
+                &log_switch($r,\%data,$extra_env);
+            }
+        }
+    }
+
     if (!$data{'role'}) {
 	my $handle = &Apache::lonnet::check_for_valid_session($r);
 	if ($handle) {