--- loncom/lonnet/perl/lonnet.pm 2022/09/08 01:41:15 1.1489 +++ 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.1489 2022/09/08 01:41:15 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 { @@ -6849,31 +6894,31 @@ sub course_adhocrole_privs { $full{$priv} = $restrict; } foreach my $item (split(/,/,$overrides{"internal.adhocpriv.$rolename"})) { - next if ($item eq ''); - my ($rule,$rest) = split(/=/,$item); - next unless (($rule eq 'off') || ($rule eq 'on')); - foreach my $priv (split(/:/,$rest)) { - if ($priv ne '') { - if ($rule eq 'off') { - $possremove{$priv} = 1; - } else { - $possadd{$priv} = 1; - } - } - } - } - foreach my $priv (sort(keys(%full))) { - if (exists($currprivs{$priv})) { - unless (exists($possremove{$priv})) { - $storeprivs{$priv} = $currprivs{$priv}; - } - } elsif (exists($possadd{$priv})) { - $storeprivs{$priv} = $full{$priv}; - } - } - $coursepriv = ':'.join(':',map { $_.'&'.$storeprivs{$_}; } sort(keys(%storeprivs))); - } - return $coursepriv; + next if ($item eq ''); + my ($rule,$rest) = split(/=/,$item); + next unless (($rule eq 'off') || ($rule eq 'on')); + foreach my $priv (split(/:/,$rest)) { + if ($priv ne '') { + if ($rule eq 'off') { + $possremove{$priv} = 1; + } else { + $possadd{$priv} = 1; + } + } + } + } + foreach my $priv (sort(keys(%full))) { + if (exists($currprivs{$priv})) { + unless (exists($possremove{$priv})) { + $storeprivs{$priv} = $currprivs{$priv}; + } + } elsif (exists($possadd{$priv})) { + $storeprivs{$priv} = $full{$priv}; + } + } + $coursepriv = ':'.join(':',map { $_.'&'.$storeprivs{$_}; } sort(keys(%storeprivs))); + } + return $coursepriv; } sub group_roleprivs { @@ -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'});