--- loncom/lonnet/perl/lonnet.pm 2015/05/22 18:06:13 1.1172.2.68 +++ loncom/lonnet/perl/lonnet.pm 2016/08/05 15:34:27 1.1172.2.72 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1172.2.68 2015/05/22 18:06:13 raeburn Exp $ +# $Id: lonnet.pm,v 1.1172.2.72 2016/08/05 15:34:27 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -417,8 +417,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)"); @@ -464,7 +464,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; @@ -1934,6 +1934,63 @@ sub get_instuser { return ($outcome,%userinfo); } +sub get_multiple_instusers { + my ($udom,$users,$caller) = @_; + my ($outcome,$results); + if (ref($users) eq 'HASH') { + my $count = keys(%{$users}); + my $requested = &freeze_escape($users); + my $homeserver = &domain($udom,'primary'); + if ($homeserver ne '') { + my $queryid=&reply('querysend:getmultinstusers:::'.$caller.'='.$requested,$homeserver); + my $host=&hostname($homeserver); + if ($queryid !~/^\Q$host\E\_/) { + &logthis('get_multiple_instusers invalid queryid: '.$queryid. + ' for host: '.$homeserver.'in domain '.$udom); + return ($outcome,$results); + } + my $response = &get_query_reply($queryid); + my $maxtries = 5; + if ($count > 100) { + $maxtries = 1+int($count/20); + } + my $tries = 1; + while (($response=~/^timeout/) && ($tries <= $maxtries)) { + $response = &get_query_reply($queryid); + $tries ++; + } + if ($response eq '') { + $results = {}; + foreach my $key (keys(%{$users})) { + my ($uname,$id); + if ($caller eq 'id') { + $id = $key; + } else { + $uname = $key; + } + my ($resp,%info) = &get_instuser($udom,$uname,$id); + $outcome = $resp; + if ($resp eq 'ok') { + %{$results} = (%{$results}, %info); + } else { + last; + } + } + } elsif(!&error($response) && ($response ne 'refused')) { + if (($response eq 'unavailable') || ($response eq 'invalid') || ($response eq 'timeout')) { + $outcome = $response; + } else { + ($outcome,my $userdata) = split(/=/,$response,2); + if ($outcome eq 'ok') { + $results = &thaw_unescape($userdata); + } + } + } + } + } + return ($outcome,$results); +} + sub inst_rulecheck { my ($udom,$uname,$id,$item,$rules) = @_; my %returnhash; @@ -10007,10 +10064,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); @@ -12227,8 +12286,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>; @@ -12314,8 +12373,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); @@ -12337,7 +12396,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; } @@ -12459,7 +12519,7 @@ sub fetch_dns_checksums { } sub get_iphost { - my ($ignore_cache) = @_; + my ($ignore_cache,$nocache) = @_; if (!$ignore_cache) { if (%iphost) { @@ -12483,7 +12543,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})) { @@ -12508,9 +12568,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; }