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

Diff for /loncom/interface/loncommon.pm between versions 1.1075.2.127.2.2 and 1.1075.2.127.6.2

version 1.1075.2.127.2.2, 2017/10/15 14:10:08 version 1.1075.2.127.6.2, 2020/02/19 23:36:09
Line 4946  sub check_ip_acc { Line 4946  sub check_ip_acc {
     if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {      if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {
         return 1;          return 1;
     }      }
     my $allowed=0;      my ($ip,$allowed);
     my $ip=$ENV{'REMOTE_ADDR'} || $clientip || $env{'request.host'};      if (($ENV{'REMOTE_ADDR'} eq '127.0.0.1') ||
           ($ENV{'REMOTE_ADDR'} eq &Apache::lonnet::get_host_ip($Apache::lonnet::perlvar{'lonHostID'}))) {
     my $name;          $ip = $env{'request.host'} || $ENV{'REMOTE_ADDR'} || $clientip;
     foreach my $pattern (split(',',$acc)) {      } else {
         $pattern =~ s/^\s*//;          $ip = $ENV{'REMOTE_ADDR'} || $env{'request.host'} || $clientip;
         $pattern =~ s/\s*$//;  
         if ($pattern =~ /\*$/) {  
             #35.8.*  
             $pattern=~s/\*//;  
             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }  
         } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) {  
             #35.8.3.[34-56]  
             my $low=$2;  
             my $high=$3;  
             $pattern=$1;  
             if ($ip =~ /^\Q$pattern\E/) {  
                 my $last=(split(/\./,$ip))[3];  
                 if ($last <=$high && $last >=$low) { $allowed=1; }  
             }  
         } elsif ($pattern =~ /^\*/) {  
             #*.msu.edu  
             $pattern=~s/\*//;  
             if (!defined($name)) {  
                 use Socket;  
                 my $netaddr=inet_aton($ip);  
                 ($name)=gethostbyaddr($netaddr,AF_INET);  
             }  
             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }  
         } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) {  
             #127.0.0.1  
             if ($ip =~ /^\Q$pattern\E/) { $allowed=1; }  
         } else {  
             #some.name.com  
             if (!defined($name)) {  
                 use Socket;  
                 my $netaddr=inet_aton($ip);  
                 ($name)=gethostbyaddr($netaddr,AF_INET);  
             }  
             if ($name =~ /\Q$pattern\E$/i) { $allowed=1; }  
         }  
         if ($allowed) { last; }  
     }  
     return $allowed;  
 }  
   
 sub check_slotip_acc {  
     my ($acc,$clientip)=@_;  
     &Apache::lonxml::debug("acc is $acc");  
     if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) {  
         return 1;  
     }      }
     my $allowed;  
     my $ip=$ENV{'REMOTE_ADDR'} || $clientip || $env{'request.host'};  
   
     my $name;      my $name;
     my %access = (      my %access = (
Line 5011  sub check_slotip_acc { Line 4964  sub check_slotip_acc {
     foreach my $item (split(',',$acc)) {      foreach my $item (split(',',$acc)) {
         $item =~ s/^\s*//;          $item =~ s/^\s*//;
         $item =~ s/\s*$//;          $item =~ s/\s*$//;
         my $pattern;  
         if ($item =~ /^\!(.+)$/) {          if ($item =~ /^\!(.+)$/) {
             push(@denies,$1);              push(@denies,$1);
         } else {          } else {
             push(@allows,$item);              push(@allows,$item);
         }          }
    }      }
    my $numdenies = scalar(@denies);      my $numdenies = scalar(@denies);
    my $numallows = scalar(@allows);      my $numallows = scalar(@allows);
    my $count = 0;      my $count = 0;
    foreach my $pattern (@denies,@allows) {      foreach my $pattern (@denies,@allows) {
         $count ++;          $count ++;
         my $acctype = 'allowfrom';          my $acctype = 'allowfrom';
         if ($count <= $numdenies) {          if ($count <= $numdenies) {
Line 14069  defdom (domain for which to retrieve con Line 14021  defdom (domain for which to retrieve con
 origmail (scalar - email address of recipient from loncapa.conf,  origmail (scalar - email address of recipient from loncapa.conf,
 i.e., predates configuration by DC via domainprefs.pm  i.e., predates configuration by DC via domainprefs.pm
   
 $requname username of requester (if mailing type is helpdeskmail)  
   
 $requdom domain of requester (if mailing type is helpdeskmail)  
   
 $reqemail e-mail address of requester (if mailing type is helpdeskmail)  
   
   
 Returns: comma separated list of addresses to which to send e-mail.  Returns: comma separated list of addresses to which to send e-mail.
   
 =back  =back
Line 14085  Returns: comma separated list of address Line 14030  Returns: comma separated list of address
 ############################################################  ############################################################
 ############################################################  ############################################################
 sub build_recipient_list {  sub build_recipient_list {
     my ($defmail,$mailing,$defdom,$origmail,$requname,$requdom,$reqemail) = @_;      my ($defmail,$mailing,$defdom,$origmail) = @_;
     my @recipients;      my @recipients;
     my ($otheremails,$lastresort,$allbcc,$addtext);      my ($otheremails,$lastresort,$allbcc,$addtext);
     my %domconfig =      my %domconfig =
Line 14126  sub build_recipient_list { Line 14071  sub build_recipient_list {
         } elsif ($origmail ne '') {          } elsif ($origmail ne '') {
             $lastresort = $origmail;              $lastresort = $origmail;
         }          }
         if ($mailing eq 'helpdeskmail') {  
             if ((ref($domconfig{'contacts'}{'overrides'}) eq 'HASH') &&  
                 (keys(%{$domconfig{'contacts'}{'overrides'}}))) {  
                 my ($inststatus,$inststatus_checked);  
                 if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '') &&  
                     ($env{'user.domain'} ne 'public')) {  
                     $inststatus_checked = 1;  
                     $inststatus = $env{'environment.inststatus'};  
                 }  
                 unless ($inststatus_checked) {  
                     if (($requname ne '') && ($requdom ne '')) {  
                         if (($requname =~ /^$match_username$/) &&  
                             ($requdom =~ /^$match_domain$/) &&  
                             (&Apache::lonnet::domain($requdom))) {  
                             my $requhome = &Apache::lonnet::homeserver($requname,  
                                                                       $requdom);  
                             unless ($requhome eq 'no_host') {  
                                 my %userenv = &Apache::lonnet::userenvironment($requdom,$requname,'inststatus');  
                                 $inststatus = $userenv{'inststatus'};  
                                 $inststatus_checked = 1;  
                             }  
                         }  
                     }  
                 }  
                 unless ($inststatus_checked) {  
                     if ($reqemail =~ /^[^\@]+\@[^\@]+$/) {  
                         my %srch = (srchby     => 'email',  
                                     srchdomain => $defdom,  
                                     srchterm   => $reqemail,  
                                     srchtype   => 'exact');  
                         my %srch_results = &Apache::lonnet::usersearch(\%srch);  
                         foreach my $uname (keys(%srch_results)) {  
                             if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {  
                                 $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});  
                                 $inststatus_checked = 1;  
                                 last;  
                             }  
                         }  
                         unless ($inststatus_checked) {  
                             my ($dirsrchres,%srch_results) = &Apache::lonnet::inst_directory_query(\%srch);  
                             if ($dirsrchres eq 'ok') {  
                                 foreach my $uname (keys(%srch_results)) {  
                                     if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') {  
                                         $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}});  
                                         $inststatus_checked = 1;  
                                         last;  
                                     }  
                                 }  
                             }  
                         }  
                     }  
                 }  
                 if ($inststatus ne '') {  
                     foreach my $status (split(/\:/,$inststatus)) {  
                         if (ref($domconfig{'contacts'}{'overrides'}{$status}) eq 'HASH') {  
                             my @contacts = ('adminemail','supportemail');  
                             foreach my $item (@contacts) {  
                                 if ($domconfig{'contacts'}{'overrides'}{$status}{$item}) {  
                                     my $addr = $domconfig{'contacts'}{'overrides'}{$status};  
                                     if (!grep(/^\Q$addr\E$/,@recipients)) {  
                                         push(@recipients,$addr);  
                                     }  
                                 }  
                             }  
                             $otheremails = $domconfig{'contacts'}{'overrides'}{$status}{'others'};  
                             if ($domconfig{'contacts'}{'overrides'}{$status}{'bcc'}) {  
                                 my @bccs = split(/,/,$domconfig{'contacts'}{'overrides'}{$status}{'bcc'});  
                                 my @ok_bccs;  
                                 foreach my $bcc (@bccs) {  
                                     $bcc =~ s/^\s+//g;  
                                     $bcc =~ s/\s+$//g;  
                                     if ($bcc =~ m/^[^\@]+\@[^\@]+$/) {  
                                         if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) {  
                                             push(@ok_bccs,$bcc);  
                                         }  
                                     }  
                                 }  
                                 if (@ok_bccs > 0) {  
                                     $allbcc = join(', ',@ok_bccs);  
                                 }  
                             }  
                             $addtext = $domconfig{'contacts'}{'overrides'}{$status}{'include'};  
                             last;  
                         }  
                     }  
                 }  
             }  
         }  
     } elsif ($origmail ne '') {      } elsif ($origmail ne '') {
         $lastresort = $origmail;          $lastresort = $origmail;
     }      }
   
     if (($mailing eq 'helpdeskmail') && ($lastresort ne '')) {      if (($mailing eq 'helpdesk') && ($lastresort ne '')) {
         unless (grep(/^\Q$defdom\E$/,&Apache::lonnet::current_machine_domains())) {          unless (grep(/^\Q$defdom\E$/,&Apache::lonnet::current_machine_domains())) {
             my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};              my $lonhost = $Apache::lonnet::perlvar{'lonHostID'};
             my $machinedom = $Apache::lonnet::perlvar{'lonDefDomain'};              my $machinedom = $Apache::lonnet::perlvar{'lonDefDomain'};
Line 14298  sub build_recipient_list { Line 14155  sub build_recipient_list {
             }              }
         }          }
     }      }
     if ($mailing eq 'helpdeskmail') {      if ($mailing eq 'helpdesk') {
         if ((!@recipients) && ($lastresort ne '')) {          if ((!@recipients) && ($lastresort ne '')) {
             push(@recipients,$lastresort);              push(@recipients,$lastresort);
         }          }
Removed from v.1.1075.2.127.2.2  
changed lines
  Added in v.1.1075.2.127.6.2

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