--- loncom/lonnet/perl/lonnet.pm 2016/08/05 11:14:06 1.1172.2.69
+++ loncom/lonnet/perl/lonnet.pm 2016/08/06 01:18:07 1.1172.2.74
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.1172.2.69 2016/08/05 11:14:06 raeburn Exp $
+# $Id: lonnet.pm,v 1.1172.2.74 2016/08/06 01:18:07 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;
@@ -1554,7 +1554,7 @@ sub idget {
my %servers = &get_servers($udom,'library');
foreach my $tryserver (keys(%servers)) {
- my $idlist=join('&',@ids);
+ my $idlist=join('&', map { &escape($_); } @ids);
$idlist=~tr/A-Z/a-z/;
my $reply=&reply("idget:$udom:".$idlist,$tryserver);
my @answer=();
@@ -1564,7 +1564,7 @@ sub idget {
my $i;
for ($i=0;$i<=$#ids;$i++) {
if ($answer[$i]) {
- $returnhash{$ids[$i]}=$answer[$i];
+ $returnhash{$ids[$i]}=&unescape($answer[$i]);
}
}
}
@@ -1793,7 +1793,7 @@ sub retrieve_inst_usertypes {
sub is_domainimage {
my ($url) = @_;
- if ($url=~m-^/+res/+($match_domain)/+\1\-domainconfig/+(img|logo|domlogo)/+-) {
+ if ($url=~m-^/+res/+($match_domain)/+\1\-domainconfig/+(img|logo|domlogo)/+[^/]-) {
if (&domain($1) ne '') {
return '1';
}
@@ -10064,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);
@@ -12284,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>;
@@ -12371,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);
@@ -12394,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;
}
@@ -12516,7 +12519,7 @@ sub fetch_dns_checksums {
}
sub get_iphost {
- my ($ignore_cache) = @_;
+ my ($ignore_cache,$nocache) = @_;
if (!$ignore_cache) {
if (%iphost) {
@@ -12540,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})) {
@@ -12565,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;
}