[BACK]Return to lonnet.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / lonnet / perl

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.1346 and 1.1347

version 1.1346, 2017/05/25 23:55:42 version 1.1347, 2017/08/07 20:22:54
Line 1598  sub internet_dom_servers { Line 1598  sub internet_dom_servers {
     return %uniqservers;      return %uniqservers;
 }  }
   
   sub notcallable {
       my ($cmdtype,$calldom) = @_;
       if (&domain($calldom) eq '') {
           return 1;
       }
       unless ($cmdtype =~ /^(content|shared|enroll|coaurem|domroles|catalog|reqcrs|msg)$/) {
           return 1;
       }
       my @machinedoms = &current_machine_domains();
       if (grep(/^\Q$calldom\E$/,@machinedoms)) {
           return;
       }
       my $reject;
       my $intdom = &internet_dom($perlvar{'lonHostID'});
       if ($intdom eq '') {
           return 1;
       }
       my $callprimary = &domain($calldom,'primary');
       my $intcalldom = &Apache::lonnet::internet_dom($callprimary);
       unless ($intdom eq $intcalldom) {
           my ($trustconfig,$cached)=&Apache::lonnet::is_cached_new('trust',$calldom);
           unless (defined($cached)) {
               my %domconfig = &Apache::lonnet::get_dom('configuration',['trust'],$calldom);
               &Apache::lonnet::do_cache_new('trust',$calldom,$domconfig{'trust'},3600);
               $trustconfig = $domconfig{'trust'};
           }
           if (ref($trustconfig)) {
               if (ref($trustconfig->{$cmdtype}) eq 'HASH') {
                   if (ref($trustconfig->{$cmdtype}->{'exc'}) eq 'ARRAY') {
                       if (grep(/^\Q$intdom\E$/,@{$trustconfig->{$cmdtype}->{'exc'}})) {
                           $reject = 1;
                       }
                   }
                   if (ref($trustconfig->{$cmdtype}->{'inc'}) eq 'ARRAY') {
                       if (grep(/^\Q$intdom\E$/,@{$trustconfig->{$cmdtype}->{'inc'}})) {
                           $reject = 0;
                       } else {
                           $reject = 1;
                       }
                   }
               }
           }
       }
       return $reject;
   }
   
   sub trusted_domains {
       my ($cmdtype,$calldom) = @_;
       my (%trusted,%untrusted);
       if (&domain($calldom) eq '') {
           return (\%trusted,\%untrusted);
       }
       unless ($cmdtype =~ /^(content|shared|enroll|coaurem|domroles|catalog|reqcrs|msg)$/) {
           return (\%trusted,\%untrusted);
       }
       my $callprimary = &domain($calldom,'primary');
       my $intcalldom = &Apache::lonnet::internet_dom($callprimary);
       if ($intcalldom eq '') {
           return (\%trusted,\%untrusted);
       }
   
       my ($trustconfig,$cached)=&Apache::lonnet::is_cached_new('trust',$calldom);
       unless (defined($cached)) {
           my %domconfig = &Apache::lonnet::get_dom('configuration',['trust'],$calldom);
           &Apache::lonnet::do_cache_new('trust',$calldom,$domconfig{'trust'},3600);
           $trustconfig = $domconfig{'trust'};
       }
       if (ref($trustconfig)) {
           my (%possexc,%possinc,@allexc,@allinc); 
           if (ref($trustconfig->{$cmdtype}) eq 'HASH') {
               if (ref($trustconfig->{$cmdtype}->{'exc'}) eq 'ARRAY') {
                   map { $possexc{$_} = 1; } @{$trustconfig->{$cmdtype}->{'exc'}}; 
               }
               if (ref($trustconfig->{$cmdtype}->{'inc'}) eq 'ARRAY') {
                   map { $possinc{$_} = 1; } @{$trustconfig->{$cmdtype}->{'inc'}};
               }
           }
           if (keys(%possexc)) {
               if (keys(%possinc)) {
                   foreach my $key (sort(keys(%possexc))) {
                       next if ($key eq $intcalldom);
                       unless ($possinc{$key}) {
                           push(@allexc,$key);
                       }
                   }
               } else {
                   @allexc = sort(keys(%possexc));
               }
           }
           if (keys(%possinc)) {
               $possinc{$intcalldom} = 1;
               @allinc = sort(keys(%possinc));
           }
           if ((@allexc > 0) || (@allinc > 0)) {
               my %doms_by_intdom;
               my %allintdoms = &all_host_intdom();
               my %alldoms = &all_host_domain();
               foreach my $key (%allintdoms) {
                   if (ref($doms_by_intdom{$allintdoms{$key}}) eq 'ARRAY') {
                       unless (grep(/^\Q$alldoms{$key}\E$/,@{$doms_by_intdom{$allintdoms{$key}}})) {
                           push(@{$doms_by_intdom{$allintdoms{$key}}},$alldoms{$key});
                       }
                   } else {
                       $doms_by_intdom{$allintdoms{$key}} = [$alldoms{$key}]; 
                   }
               }
               foreach my $exc (@allexc) {
                   if (ref($doms_by_intdom{$exc}) eq 'ARRAY') {
                       map { $untrusted{$_}; } @{$doms_by_intdom{$exc}};
                   }
               }
               foreach my $inc (@allinc) {
                   if (ref($doms_by_intdom{$inc}) eq 'ARRAY') {
                       map { $trusted{$_}; } @{$doms_by_intdom{$inc}};
                   }
               }
           }
       }
       return(\%trusted,\%untrusted);
   }
   
   sub will_trust {
       my ($cmdtype,$domain,$possdom) = @_;
       return 1 if ($domain eq $possdom);
       my ($trustedref,$untrustedref) = &trusted_domains($cmdtype,$possdom);
       my $willtrust; 
       if ((ref($trustedref) eq 'ARRAY') && (@{$trustedref} > 0)) {
           if (grep(/^\Q$domain\E$/,@{$trustedref})) {
               $willtrust = 1;
           }
       } elsif ((ref($untrustedref) eq 'ARRAY') && (@{$untrustedref} > 0)) {
           unless (grep(/^\Q$domain\E$/,@{$untrustedref})) {
               $willtrust = 1;
           }
       } else {
           $willtrust = 1;
       }
       return $willtrust;
   }
   
 # ---------------------- Find the homebase for a user from domain's lib servers  # ---------------------- Find the homebase for a user from domain's lib servers
   
 my %homecache;  my %homecache;
Removed from v.1.1346  
changed lines
  Added in v.1.1347

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