--- loncom/lonnet/perl/lonnet.pm 2007/03/08 01:58:41 1.846 +++ loncom/lonnet/perl/lonnet.pm 2007/03/28 00:05:45 1.851 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.846 2007/03/08 01:58:41 albertel Exp $ +# $Id: lonnet.pm,v 1.851 2007/03/28 00:05:45 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -35,7 +35,7 @@ use HTTP::Headers; use HTTP::Date; # use Date::Parse; use vars -qw(%perlvar %badServerCache %iphost %spareid +qw(%perlvar %badServerCache %spareid %pr %prp $memcache %packagetab %courselogs %accesshash %userrolehash %domainrolehash $processmarker $dumpcount %coursedombuf %coursenumbuf %coursehombuf %coursedescrbuf %courseinstcodebuf %courseownerbuf %coursetypebuf @@ -144,6 +144,20 @@ sub logperm { return 1; } +sub create_connection { + my ($server) = @_; + my $client=IO::Socket::UNIX->new(Peer => $perlvar{'lonSockCreate'}, + Type => SOCK_STREAM, + Timeout => 10); + return 0 if (!$client); + print $client ("$server\n"); + my $result = <$client>; + chomp($result); + return 1 if ($result eq 'done'); + return 0; +} + + # -------------------------------------------------- Non-critical communication sub subreply { my ($cmd,$server)=@_; @@ -170,8 +184,10 @@ sub subreply { Timeout => 10); if($client) { last; # Connected! + } else { + &create_connection(&hostname($server)); } - sleep(1); # Try again later if failed connection. + sleep(1); # Try again later if failed connection. } my $answer; if ($client) { @@ -1010,10 +1026,16 @@ my %remembered; my %accessed; my $kicks=0; my $hits=0; +sub make_key { + my ($name,$id) = @_; + if (length($id) > 200) { $id=length($id).':'.&Digest::MD5::md5_hex($id); } + return &escape($name.':'.$id); +} + sub devalidate_cache_new { my ($name,$id,$debug) = @_; if ($debug) { &Apache::lonnet::logthis("deleting $name:$id"); } - $id=&escape($name.':'.$id); + $id=&make_key($name,$id); $memcache->delete($id); delete($remembered{$id}); delete($accessed{$id}); @@ -1021,7 +1043,7 @@ sub devalidate_cache_new { sub is_cached_new { my ($name,$id,$debug) = @_; - $id=&escape($name.':'.$id); + $id=&make_key($name,$id); if (exists($remembered{$id})) { if ($debug) { &Apache::lonnet::logthis("Earyl return $id of $remembered{$id} "); } $accessed{$id}=[&gettimeofday()]; @@ -1044,7 +1066,7 @@ sub is_cached_new { sub do_cache_new { my ($name,$id,$value,$time,$debug) = @_; - $id=&escape($name.':'.$id); + $id=&make_key($name,$id); my $setvalue=$value; if (!defined($setvalue)) { $setvalue='__undef__'; @@ -6176,7 +6198,8 @@ sub packages_tab_default { $do_default=1; } elsif ($pack_type eq 'extension') { push(@extension,[$package,$pack_type,$pack_part]); - } else { + } elsif ($pack_part eq $part) { + # only look at packages defaults for packages that this id is push(@specifics,[$package,$pack_type,$pack_part]); } } @@ -7671,36 +7694,39 @@ BEGIN { } } -sub get_hosts_from_ip { - my ($ip) = @_; - my %iphosts = &get_iphost(); - if (ref($iphosts{$ip})) { - return @{$iphosts{$ip}}; +{ + my %iphost; + sub get_hosts_from_ip { + my ($ip) = @_; + my %iphosts = &get_iphost(); + if (ref($iphosts{$ip})) { + return @{$iphosts{$ip}}; + } + return; } - return; -} - -sub get_iphost { - if (%iphost) { return %iphost; } - my %name_to_ip; - my %hostname = &all_hostnames(); - foreach my $id (keys(%hostname)) { - my $name=$hostname{$id}; - my $ip; - if (!exists($name_to_ip{$name})) { - $ip = gethostbyname($name); - if (!$ip || length($ip) ne 4) { - &logthis("Skipping host $id name $name no IP found"); - next; + + sub get_iphost { + if (%iphost) { return %iphost; } + my %name_to_ip; + my %hostname = &all_hostnames(); + foreach my $id (keys(%hostname)) { + my $name=$hostname{$id}; + my $ip; + if (!exists($name_to_ip{$name})) { + $ip = gethostbyname($name); + if (!$ip || length($ip) ne 4) { + &logthis("Skipping host $id name $name no IP found"); + next; + } + $ip=inet_ntoa($ip); + $name_to_ip{$name} = $ip; + } else { + $ip = $name_to_ip{$name}; } - $ip=inet_ntoa($ip); - $name_to_ip{$name} = $ip; - } else { - $ip = $name_to_ip{$name}; + push(@{$iphost{$ip}},$id); } - push(@{$iphost{$ip}},$id); + return %iphost; } - return %iphost; } # ------------------------------------------------------ Read spare server file