--- loncom/lonnet/perl/lonnet.pm 2007/06/18 22:49:57 1.891 +++ loncom/lonnet/perl/lonnet.pm 2007/06/25 18:12:24 1.894 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.891 2007/06/18 22:49:57 albertel Exp $ +# $Id: lonnet.pm,v 1.894 2007/06/25 18:12:24 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -3804,26 +3804,40 @@ sub customaccess { $ucrs = &LONCAPA::clean_username($ucrs); my $access=0; foreach my $right (split(/\s*\,\s*/,&metadata($uri,'rule_rights'))) { - my ($effect,$realm,$role)=split(/\:/,$right); - if ($role) { - if ($role ne $urole) { next; } - } - foreach my $scope (split(/\s*\,\s*/,$realm)) { - my ($tdom,$tcrs,$tsec)=split(/\_/,$scope); - if ($tdom) { - if ($tdom ne $udom) { next; } - } - if ($tcrs) { - if ($tcrs ne $ucrs) { next; } - } - if ($tsec) { - if ($tsec ne $usec) { next; } - } - $access=($effect eq 'allow'); - last; - } - if ($realm eq '' && $role eq '') { - $access=($effect eq 'allow'); + my ($effect,$realm,$role,$type)=split(/\:/,$right); + if ($type eq 'user') { + foreach my $scope (split(/\s*\,\s*/,$realm)) { + my ($tdom,$tcrs)=split(/\_/,$scope); + if ($tdom) { + if ($tdom ne $env{'user.domain'}) { next; } + } + if ($tcrs) { + if ($tcrs ne $env{'user.name'}) { next; } + } + $access=($effect eq 'allow'); + last; + } + } else { + if ($role) { + if ($role ne $urole) { next; } + } + foreach my $scope (split(/\s*\,\s*/,$realm)) { + my ($tdom,$tcrs,$tsec)=split(/\_/,$scope); + if ($tdom) { + if ($tdom ne $udom) { next; } + } + if ($tcrs) { + if ($tcrs ne $ucrs) { next; } + } + if ($tsec) { + if ($tsec ne $usec) { next; } + } + $access=($effect eq 'allow'); + last; + } + if ($realm eq '' && $role eq '') { + $access=($effect eq 'allow'); + } } } return $access; @@ -7872,6 +7886,7 @@ sub get_dns { sub reset_hosts_info { &reset_domain_info(); &reset_hosts_ip_info(); + undef(%name_to_host); undef(%hostname); undef(%hostdom); undef(%libserv); @@ -7963,24 +7978,6 @@ sub get_dns { my %name_to_ip; my %lonid_to_ip; - my %valid_ip; - sub valid_ip { - my ($ip) = @_; - if (exists($iphost{$ip}) || exists($valid_ip{$ip})) { - return 1; - } - my $name = gethostbyip($ip); - my $lonid = &hostname($name); - if (defined($lonid)) { - $valid_ip{$ip} = $lonid; - return 1; - } - my %iphosts = &get_iphost(); - if (ref($iphost{$ip})) { - return 1; - } - } - sub get_hosts_from_ip { my ($ip) = @_; my %iphosts = &get_iphost(); @@ -8012,6 +8009,7 @@ sub get_dns { sub get_iphost { my ($ignore_cache) = @_; + if (!$ignore_cache) { if (%iphost) { return %iphost; @@ -8025,16 +8023,31 @@ sub get_dns { return %iphost; } } + + # get yesterday's info for fallback + my %old_name_to_ip; + my ($ip_info,$cached)= + &Apache::lonnet::is_cached_new('iphost','iphost'); + if ($cached) { + %old_name_to_ip = %{$ip_info->[1]}; + } + my %name_to_host = &all_names(); foreach my $name (keys(%name_to_host)) { my $ip; if (!exists($name_to_ip{$name})) { $ip = gethostbyname($name); if (!$ip || length($ip) ne 4) { - &logthis("Skipping name $name no IP found"); - next; + if (defined($old_name_to_ip{$name})) { + $ip = $old_name_to_ip{$name}; + &logthis("Can't find $name defaulting to old $ip"); + } else { + &logthis("Name $name no IP found"); + next; + } + } else { + $ip=inet_ntoa($ip); } - $ip=inet_ntoa($ip); $name_to_ip{$name} = $ip; } else { $ip = $name_to_ip{$name}; @@ -8046,7 +8059,7 @@ sub get_dns { } &Apache::lonnet::do_cache_new('iphost','iphost', [\%iphost,\%name_to_ip,\%lonid_to_ip], - 24*60*60); + 48*60*60); return %iphost; }