Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.1490 and 1.1493

version 1.1490, 2022/09/13 02:32:58 version 1.1493, 2022/10/07 12:53:32
Line 1378  sub authenticate { Line 1378  sub authenticate {
     return 'no_host';      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 {  sub can_host_session {
     my ($udom,$lonhost,$remoterev,$remotesessions,$hostedsessions) = @_;      my ($udom,$lonhost,$remoterev,$remotesessions,$hostedsessions) = @_;
     my $canhost = 1;      my $canhost = 1;
Line 2684  sub get_domain_defaults { Line 2707  sub get_domain_defaults {
         $domdefaults{'timezone_def'} = $domconfig{'defaults'}{'timezone_def'};          $domdefaults{'timezone_def'} = $domconfig{'defaults'}{'timezone_def'};
         $domdefaults{'datelocale_def'} = $domconfig{'defaults'}{'datelocale_def'};          $domdefaults{'datelocale_def'} = $domconfig{'defaults'}{'datelocale_def'};
         $domdefaults{'portal_def'} = $domconfig{'defaults'}{'portal_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_cost'} = $domconfig{'defaults'}{'intauth_cost'};
         $domdefaults{'intauth_switch'} = $domconfig{'defaults'}{'intauth_switch'};          $domdefaults{'intauth_switch'} = $domconfig{'defaults'}{'intauth_switch'};
         $domdefaults{'intauth_check'} = $domconfig{'defaults'}{'intauth_check'};          $domdefaults{'intauth_check'} = $domconfig{'defaults'}{'intauth_check'};
Line 2944  sub course_portal_url { Line 2969  sub course_portal_url {
     return $firsturl;      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  # --------------------------------------------- Get domain config for passwords
   
 sub get_passwdconf {  sub get_passwdconf {
Line 12371  sub courselti_itemid { Line 12416  sub courselti_itemid {
     $chome = &homeserver($cnum,$cdom);      $chome = &homeserver($cnum,$cdom);
     return if ($chome eq 'no_host');      return if ($chome eq 'no_host');
     if (ref($params) eq 'HASH') {      if (ref($params) eq 'HASH') {
         my $items = &freeze_escape($params);  
         my $rep;          my $rep;
         if (grep { $_ eq $chome } current_machine_ids()) {          if (grep { $_ eq $chome } current_machine_ids()) {
             $rep = LONCAPA::Lond::crslti_itemid($cdom,$cnum,$url,$method,$params,$perlvar{'lonVersion'});              $rep = LONCAPA::Lond::crslti_itemid($cdom,$cnum,$url,$method,$params,$perlvar{'lonVersion'});
Line 12395  sub domainlti_itemid { Line 12439  sub domainlti_itemid {
     $primary_id = &domain($cdom,'primary');      $primary_id = &domain($cdom,'primary');
     return if ($primary_id eq '');      return if ($primary_id eq '');
     if (ref($params) eq 'HASH') {      if (ref($params) eq 'HASH') {
         my $items = &freeze_escape($params);  
         my $rep;          my $rep;
         if (grep { $_ eq $primary_id } current_machine_ids()) {          if (grep { $_ eq $primary_id } current_machine_ids()) {
             $rep = LONCAPA::Lond::domlti_itemid($cdom,$context,$url,$method,$params,$perlvar{'lonVersion'});              $rep = LONCAPA::Lond::domlti_itemid($cdom,$context,$url,$method,$params,$perlvar{'lonVersion'});

Removed from v.1.1490  
changed lines
  Added in v.1.1493


FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>