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

version 1.1347, 2017/08/07 20:22:54 version 1.1350, 2017/08/23 22:38:43
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 {  sub trusted_domains {
     my ($cmdtype,$calldom) = @_;      my ($cmdtype,$calldom) = @_;
     my (%trusted,%untrusted);      my ($trusted,$untrusted);
     if (&domain($calldom) eq '') {      if (&domain($calldom) eq '') {
         return (\%trusted,\%untrusted);          return ($trusted,$untrusted);
     }      }
     unless ($cmdtype =~ /^(content|shared|enroll|coaurem|domroles|catalog|reqcrs|msg)$/) {      unless ($cmdtype =~ /^(content|shared|enroll|coaurem|domroles|catalog|reqcrs|msg)$/) {
         return (\%trusted,\%untrusted);          return ($trusted,$untrusted);
     }      }
     my $callprimary = &domain($calldom,'primary');      my $callprimary = &domain($calldom,'primary');
     my $intcalldom = &Apache::lonnet::internet_dom($callprimary);      my $intcalldom = &Apache::lonnet::internet_dom($callprimary);
     if ($intcalldom eq '') {      if ($intcalldom eq '') {
         return (\%trusted,\%untrusted);          return ($trusted,$untrusted);
     }      }
   
     my ($trustconfig,$cached)=&Apache::lonnet::is_cached_new('trust',$calldom);      my ($trustconfig,$cached)=&Apache::lonnet::is_cached_new('trust',$calldom);
Line 1706  sub trusted_domains { Line 1660  sub trusted_domains {
             }              }
             foreach my $exc (@allexc) {              foreach my $exc (@allexc) {
                 if (ref($doms_by_intdom{$exc}) eq 'ARRAY') {                  if (ref($doms_by_intdom{$exc}) eq 'ARRAY') {
                     map { $untrusted{$_}; } @{$doms_by_intdom{$exc}};                      $untrusted = $doms_by_intdom{$exc};
                 }                  }
             }              }
             foreach my $inc (@allinc) {              foreach my $inc (@allinc) {
                 if (ref($doms_by_intdom{$inc}) eq 'ARRAY') {                  if (ref($doms_by_intdom{$inc}) eq 'ARRAY') {
                     map { $trusted{$_}; } @{$doms_by_intdom{$inc}};                      $trusted = $doms_by_intdom{$inc};
                 }                  }
             }              }
         }          }
     }      }
     return(\%trusted,\%untrusted);      return ($trusted,$untrusted);
 }  }
   
 sub will_trust {  sub will_trust {
Line 3740  sub userfileupload { Line 3694  sub userfileupload {
                          '_'.$env{'user.domain'}.'/pending';                           '_'.$env{'user.domain'}.'/pending';
         } elsif (($context eq 'existingfile') || ($context eq 'canceloverwrite')) {          } elsif (($context eq 'existingfile') || ($context eq 'canceloverwrite')) {
             my ($docuname,$docudom);              my ($docuname,$docudom);
             if ($destudom) {              if ($destudom =~ /^$match_domain$/) {
                 $docudom = $destudom;                  $docudom = $destudom;
             } else {              } else {
                 $docudom = $env{'user.domain'};                  $docudom = $env{'user.domain'};
             }              }
             if ($destuname) {              if ($destuname =~ /^$match_username$/) {
                 $docuname = $destuname;                  $docuname = $destuname;
             } else {              } else {
                 $docuname = $env{'user.name'};                  $docuname = $env{'user.name'};

Removed from v.1.1347  
changed lines
  Added in v.1.1350


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