--- loncom/lonnet/perl/lonnet.pm 2022/09/13 02:32:58 1.1490 +++ loncom/lonnet/perl/lonnet.pm 2022/09/13 12:22:15 1.1491 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1490 2022/09/13 02:32:58 raeburn Exp $ +# $Id: lonnet.pm,v 1.1491 2022/09/13 12:22:15 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -1378,6 +1378,29 @@ sub authenticate { return 'no_host'; } +sub can_switchserver { + my ($udom,$home) = @_; + my ($canswitch,@intdoms); + my $internet_names = &get_internet_names($home); + if (ref($internet_names) eq 'ARRAY') { + @intdoms = @{$internet_names}; + } + my $uint_dom = &internet_dom(&domain($udom,'primary')); + if ($uint_dom ne '' && grep(/^\Q$uint_dom\E$/,@intdoms)) { + $canswitch = 1; + } else { + my $serverhomeID = &get_server_homeID(&hostname($home)); + my $serverhomedom = &host_domain($serverhomeID); + my %defdomdefaults = &get_domain_defaults($serverhomedom); + my %udomdefaults = &get_domain_defaults($udom); + my $remoterev = &get_server_loncaparev('',$home); + $canswitch = &can_host_session($udom,$home,$remoterev, + $udomdefaults{'remotesessions'}, + $defdomdefaults{'hostedsessions'}); + } + return $canswitch; +} + sub can_host_session { my ($udom,$lonhost,$remoterev,$remotesessions,$hostedsessions) = @_; my $canhost = 1;