--- loncom/lonnet/perl/lonnet.pm 2007/06/18 22:49:57 1.891 +++ loncom/lonnet/perl/lonnet.pm 2007/06/22 00:11:04 1.893 @@ -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.893 2007/06/22 00:11:04 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();