--- loncom/lonnet/perl/lonnet.pm 2015/08/05 18:47:25 1.1290 +++ loncom/lonnet/perl/lonnet.pm 2015/10/26 16:03:42 1.1295 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1290 2015/08/05 18:47:25 raeburn Exp $ +# $Id: lonnet.pm,v 1.1295 2015/10/26 16:03:42 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -422,8 +422,8 @@ sub reply { sub reconlonc { my ($lonid) = @_; - my $hostname = &hostname($lonid); if ($lonid) { + my $hostname = &hostname($lonid); my $peerfile="$perlvar{'lonSockDir'}/$hostname"; if ($hostname && -e $peerfile) { &logthis("Trying to reconnect lonc for $lonid ($hostname)"); @@ -448,7 +448,7 @@ sub reconlonc { &logthis("lonc at pid $loncpid responding, sending USR1"); kill USR1 => $loncpid; sleep 1; - } else { + } else { &logthis( "WARNING:". " lonc at pid $loncpid not responding, giving up"); @@ -469,7 +469,7 @@ sub critical { } my $answer=reply($cmd,$server); if ($answer eq 'con_lost') { - &reconlonc("$perlvar{'lonSockDir'}/$server"); + &reconlonc($server); my $answer=reply($cmd,$server); if ($answer eq 'con_lost') { my $now=time; @@ -1974,11 +1974,10 @@ sub get_multiple_instusers { $uname = $key; } my ($resp,%info) = &get_instuser($udom,$uname,$id); + $outcome = $resp; if ($resp eq 'ok') { %{$results} = (%{$results}, %info); - $outcome = 'ok'; } else { - $outcome = $resp; last; } } @@ -1986,7 +1985,7 @@ sub get_multiple_instusers { if (($response eq 'unavailable') || ($response eq 'invalid') || ($response eq 'timeout')) { $outcome = $response; } else { - ($outcome,my $userdata) = split(/:/,$response,2); + ($outcome,my $userdata) = split(/=/,$response,2); if ($outcome eq 'ok') { $results = &thaw_unescape($userdata); } @@ -7387,7 +7386,8 @@ sub get_commblock_resources { } } } - if ($interval[0] =~ /^\d+$/) { + if ($interval[0] =~ /^\d+/) { + my ($timelimit) = split(/_/,$interval[0]); my $first_access; if ($type eq 'resource') { $first_access=&get_first_access($interval[1],$item); @@ -7397,7 +7397,7 @@ sub get_commblock_resources { $first_access=&get_first_access($interval[1]); } if ($first_access) { - my $timesup = $first_access+$interval[0]; + my $timesup = $first_access+$timelimit; if ($timesup > $now) { my $activeblock; foreach my $res (@to_test) { @@ -10174,10 +10174,12 @@ sub get_userresdata { } #error 2 occurs when the .db doesn't exist if ($tmp!~/error: 2 /) { - &logthis("WARNING:". - " Trying to get resource data for ". - $uname." at ".$udom.": ". - $tmp.""); + if ((!defined($cached)) || ($tmp ne 'con_lost')) { + &logthis("WARNING:". + " Trying to get resource data for ". + $uname." at ".$udom.": ". + $tmp.""); + } } elsif ($tmp=~/error: 2 /) { #&EXT_cache_set($udom,$uname); &do_cache_new('userres',$hashid,undef,600); @@ -12395,8 +12397,8 @@ sub fetch_dns_checksums { } sub load_domain_tab { - my ($ignore_cache) = @_; - &get_dns('/adm/dns/domain',\&parse_domain_tab,$ignore_cache); + my ($ignore_cache,$nocache) = @_; + &get_dns('/adm/dns/domain',\&parse_domain_tab,$ignore_cache,$nocache); my $fh; if (open($fh,"<".$perlvar{'lonTabDir'}.'/domain.tab')) { my @lines = <$fh>; @@ -12482,8 +12484,8 @@ sub fetch_dns_checksums { } sub load_hosts_tab { - my ($ignore_cache) = @_; - &get_dns('/adm/dns/hosts',\&parse_hosts_tab,$ignore_cache); + my ($ignore_cache,$nocache) = @_; + &get_dns('/adm/dns/hosts',\&parse_hosts_tab,$ignore_cache,$nocache); open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab"); my @config = <$config>; &parse_hosts_tab(\@config); @@ -12505,7 +12507,8 @@ sub fetch_dns_checksums { } sub all_names { - &load_hosts_tab() if (!$loaded); + my ($ignore_cache,$nocache) = @_; + &load_hosts_tab($ignore_cache,$nocache) if (!$loaded); return %name_to_host; } @@ -12627,7 +12630,7 @@ sub fetch_dns_checksums { } sub get_iphost { - my ($ignore_cache) = @_; + my ($ignore_cache,$nocache) = @_; if (!$ignore_cache) { if (%iphost) { @@ -12651,7 +12654,7 @@ sub fetch_dns_checksums { %old_name_to_ip = %{$ip_info->[1]}; } - my %name_to_host = &all_names(); + my %name_to_host = &all_names($ignore_cache,$nocache); foreach my $name (keys(%name_to_host)) { my $ip; if (!exists($name_to_ip{$name})) { @@ -12676,9 +12679,11 @@ sub fetch_dns_checksums { } push(@{$iphost{$ip}},@{$name_to_host{$name}}); } - &do_cache_new('iphost','iphost', - [\%iphost,\%name_to_ip,\%lonid_to_ip], - 48*60*60); + unless ($nocache) { + &do_cache_new('iphost','iphost', + [\%iphost,\%name_to_ip,\%lonid_to_ip], + 48*60*60); + } return %iphost; }