--- loncom/lonnet/perl/lonnet.pm 2007/06/13 01:43:54 1.888 +++ 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.888 2007/06/13 01:43:54 albertel Exp $ +# $Id: lonnet.pm,v 1.893 2007/06/22 00:11:04 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -149,7 +149,7 @@ sub create_connection { Type => SOCK_STREAM, Timeout => 10); return 0 if (!$client); - print $client (join(':',$hostname,$lonid,&machine_ids($lonid))."\n"); + print $client (join(':',$hostname,$lonid,&machine_ids($hostname))."\n"); my $result = <$client>; chomp($result); return 1 if ($result eq 'done'); @@ -214,6 +214,24 @@ sub reply { # ----------------------------------------------------------- Send USR1 to lonc sub reconlonc { + my ($lonid) = @_; + my $hostname = &hostname($lonid); + if ($lonid) { + my $peerfile="$perlvar{'lonSockDir'}/$hostname"; + if ($hostname && -e $peerfile) { + &logthis("Trying to reconnect lonc for $lonid ($hostname)"); + my $client=IO::Socket::UNIX->new(Peer => $peerfile, + Type => SOCK_STREAM, + Timeout => 10); + if ($client) { + print $client ("reset_retries\n"); + my $answer=<$client>; + #reset just this one. + } + } + return; + } + &logthis("Trying to reconnect lonc"); my $loncfile="$perlvar{'lonDaemons'}/logs/lonc.pid"; if (open(my $fh,"<$loncfile")) { @@ -3786,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; @@ -7601,7 +7633,10 @@ sub machine_ids { $hostname ||= &hostname($perlvar{'lonHostID'}); my @ids; my %name_to_host = &all_names(); - return @{ $name_to_host{$hostname} }; + if (ref($name_to_host{$hostname}) eq 'ARRAY') { + return @{ $name_to_host{$hostname} }; + } + return; } sub additional_machine_domains { @@ -7714,7 +7749,6 @@ sub correct_line_ends { sub goodbye { &logthis("Starting Shut down"); - &logthis("test"); #not converted to using infrastruture and probably shouldn't be &logthis(sprintf("%-20s is %s",'%badServerCache',length(&nfreeze(\%badServerCache)))); #converted @@ -7852,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); @@ -7943,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();