--- loncom/lonnet/perl/lonnet.pm 2022/09/13 02:32:58 1.1490 +++ loncom/lonnet/perl/lonnet.pm 2022/10/07 12:53:32 1.1493 @@ -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.1493 2022/10/07 12:53:32 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; @@ -2684,6 +2707,8 @@ sub get_domain_defaults { $domdefaults{'timezone_def'} = $domconfig{'defaults'}{'timezone_def'}; $domdefaults{'datelocale_def'} = $domconfig{'defaults'}{'datelocale_def'}; $domdefaults{'portal_def'} = $domconfig{'defaults'}{'portal_def'}; + $domdefaults{'portal_def_email'} = $domconfig{'defaults'}{'portal_def_email'}; + $domdefaults{'portal_def_web'} = $domconfig{'defaults'}{'portal_def_web'}; $domdefaults{'intauth_cost'} = $domconfig{'defaults'}{'intauth_cost'}; $domdefaults{'intauth_switch'} = $domconfig{'defaults'}{'intauth_switch'}; $domdefaults{'intauth_check'} = $domconfig{'defaults'}{'intauth_check'}; @@ -2944,6 +2969,26 @@ sub course_portal_url { return $firsturl; } +sub url_prefix { + my ($r,$dom,$home,$context) = @_; + my $prefix; + my %domdefs = &get_domain_defaults($dom); + if ($domdefs{'portal_def'} && $domdefs{'portal_def_'.$context}) { + if ($domdefs{'portal_def'} =~ m{^(https?://[^/]+)}) { + $prefix = $1; + } + } + if ($prefix eq '') { + my $hostname = &hostname($home); + my $protocol = $protocol{$home}; + $protocol = 'http' if ($protocol{$home} ne 'https'); + my $alias = &use_proxy_alias($r,$home); + $hostname = $alias if ($alias ne ''); + $prefix = $protocol.'://'.$hostname; + } + return $prefix; +} + # --------------------------------------------- Get domain config for passwords sub get_passwdconf { @@ -12371,7 +12416,6 @@ sub courselti_itemid { $chome = &homeserver($cnum,$cdom); return if ($chome eq 'no_host'); if (ref($params) eq 'HASH') { - my $items = &freeze_escape($params); my $rep; if (grep { $_ eq $chome } current_machine_ids()) { $rep = LONCAPA::Lond::crslti_itemid($cdom,$cnum,$url,$method,$params,$perlvar{'lonVersion'}); @@ -12395,7 +12439,6 @@ sub domainlti_itemid { $primary_id = &domain($cdom,'primary'); return if ($primary_id eq ''); if (ref($params) eq 'HASH') { - my $items = &freeze_escape($params); my $rep; if (grep { $_ eq $primary_id } current_machine_ids()) { $rep = LONCAPA::Lond::domlti_itemid($cdom,$context,$url,$method,$params,$perlvar{'lonVersion'});