[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.1347 and 1.1351

version 1.1347, 2017/08/07 20:22:54 version 1.1351, 2017/08/23 22:46:38
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'};
Line 13409  sub fetch_dns_checksums { Line 13363  sub fetch_dns_checksums {
     my ($id,$domain,$role,$name,$protocol,$intdom)=split(/:/,$configline);      my ($id,$domain,$role,$name,$protocol,$intdom)=split(/:/,$configline);
     $name=~s/\s//g;      $name=~s/\s//g;
     if ($id && $domain && $role && $name) {      if ($id && $domain && $role && $name) {
                   if ((exists($hostname{$id})) && ($hostname{$id} ne '')) {
                       my $curr = $hostname{$id};
                       my $skip;
                       if (ref($name_to_host{$curr}) eq 'ARRAY') {
                           if (($curr eq $name) && (@{$name_to_host{$curr}} == 1)) {
                               $skip = 1;
                           } else {
                               @{$name_to_host{$curr}} = grep { $_ ne $id } @{$name_to_host{$curr}};
                           }
                       }
                       unless ($skip) {
                           push(@{$name_to_host{$name}},$id);
                       }
                   } else {
                       push(@{$name_to_host{$name}},$id);
                   }
  $hostname{$id}=$name;   $hostname{$id}=$name;
  push(@{$name_to_host{$name}}, $id);  
  $hostdom{$id}=$domain;   $hostdom{$id}=$domain;
  if ($role eq 'library') { $libserv{$id}=$name; }   if ($role eq 'library') { $libserv{$id}=$name; }
                 if (defined($protocol)) {                  if (defined($protocol)) {
Removed from v.1.1347  
changed lines
  Added in v.1.1351

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