--- loncom/lonnet/perl/lonnet.pm 2011/03/06 21:17:18 1.1105 +++ loncom/lonnet/perl/lonnet.pm 2011/06/06 16:48:44 1.1109 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1105 2011/03/06 21:17:18 raeburn Exp $ +# $Id: lonnet.pm,v 1.1109 2011/06/06 16:48:44 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -196,6 +196,29 @@ sub get_server_timezone { } } +sub get_server_distarch { + my ($lonhost,$ignore_cache) = @_; + if (defined($lonhost)) { + if (!defined(&hostname($lonhost))) { + return; + } + my $cachetime = 12*3600; + if (!$ignore_cache) { + my ($distarch,$cached)=&is_cached_new('serverdistarch',$lonhost); + if (defined($cached)) { + return $distarch; + } + } + my $rep = &reply('serverdistarch',$lonhost); + unless ($rep eq 'unknown_command' || $rep eq 'no_such_host' || + $rep eq 'con_lost' || $rep eq 'rejected' || $rep eq 'refused' || + $rep eq '') { + return &do_cache_new('serverdistarch',$lonhost,$rep,$cachetime); + } + } + return; +} + sub get_server_loncaparev { my ($dom,$lonhost,$ignore_cache,$caller) = @_; if (defined($lonhost)) { @@ -8521,7 +8544,7 @@ sub metadata { if (($uri eq '') || (($uri =~ m|^/*adm/|) && ($uri !~ m|^adm/includes|) && ($uri !~ m|/bulletinboard$|)) || - ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ m{^/*uploaded/.+\.sequence$}) || ($uri =~ m{^/*uploaded/$match_domain/$match_courseid/docs/})) { + ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ m{^/*uploaded/.+\.sequence$})) { return undef; } if (($uri =~ /^~/ || $uri =~ m{home/$match_username/public_html/}) @@ -8567,7 +8590,8 @@ sub metadata { &Apache::lonnet::ssi_body($which, ('grade_target' => 'meta')); $cachetime = 1; # only want this cached in the child not long term - } elsif ($uri !~ m -^(editupload)/-) { + } elsif (($uri !~ m -^(editupload)/-) && + ($uri !~ m{^/*uploaded/$match_domain/$match_courseid/docs/})) { my $file=&filelocation('',&clutter($filename)); #push(@{$metaentry{$uri.'.file'}},$file); $metastring=&getfile($file); @@ -9268,7 +9292,6 @@ sub rndseed { if (!$domain) { $domain=$wdomain; } if (!$username) { $username=$wusername } my $which=&get_rand_alg(); - if (defined(&getCODE())) { if ($which eq '64bit5') { return &rndseed_CODE_64bit5($symb,$courseid,$domain,$username); @@ -9305,6 +9328,7 @@ sub rndseed_32bit { #&logthis("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck"); #&logthis("rndseed :$num:$symb"); if ($_64bit) { $num=(($num<<32)>>32); } + $Apache::lonhomework::results{'resource.0.rndseed'}=$num; return $num; } } @@ -9326,6 +9350,7 @@ sub rndseed_64bit { #&logthis("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck"); #&logthis("rndseed :$num:$symb"); if ($_64bit) { $num1=(($num1<<32)>>32); $num2=(($num2<<32)>>32); } + $Apache::lonhomework::results{'resource.0.rndseed'}="$num1:$num2"; return "$num1,$num2"; } } @@ -9349,6 +9374,7 @@ sub rndseed_64bit2 { #&logthis("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck"); #&logthis("rndseed :$num:$symb"); if ($_64bit) { $num1=(($num1<<32)>>32); $num2=(($num2<<32)>>32); } + $Apache::lonhomework::results{'resource.0.rndseed'}="$num1:$num2"; return "$num1,$num2"; } } @@ -9372,7 +9398,7 @@ sub rndseed_64bit3 { #&logthis("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck"); #&logthis("rndseed :$num1:$num2:$_64bit"); if ($_64bit) { $num1=(($num1<<32)>>32); $num2=(($num2<<32)>>32); } - + $Apache::lonhomework::results{'resource.0.rndseed'}="$num1:$num2"; return "$num1:$num2"; } } @@ -9396,7 +9422,7 @@ sub rndseed_64bit4 { #&logthis("$symbseed:$nameseed;$domainseed|$courseseed;$namechck:$symbchck"); #&logthis("rndseed :$num1:$num2:$_64bit"); if ($_64bit) { $num1=(($num1<<32)>>32); $num2=(($num2<<32)>>32); } - + $Apache::lonhomework::results{'resource.0.rndseed'}="$num1:$num2"; return "$num1:$num2"; } } @@ -9404,6 +9430,7 @@ sub rndseed_64bit4 { sub rndseed_64bit5 { my ($symb,$courseid,$domain,$username)=@_; my ($num1,$num2)=&digest("$symb,$courseid,$domain,$username"); + $Apache::lonhomework::results{'resource.0.rndseed'}="$num1:$num2"; return "$num1:$num2"; } @@ -10061,13 +10088,19 @@ sub get_dns { my $loaded; my %name_to_host; my %internetdom; + my %LC_dns_serv; sub parse_hosts_tab { my ($file) = @_; foreach my $configline (@$file) { next if ($configline =~ /^(\#|\s*$ )/x); - next if ($configline =~ /^\^/); - chomp($configline); + chomp($configline); + if ($configline =~ /^\^/) { + if ($configline =~ /^\^([\w.\-]+)/) { + $LC_dns_serv{$1} = 1; + } + next; + } my ($id,$domain,$role,$name,$protocol,$intdom)=split(/:/,$configline); $name=~s/\s//g; if ($id && $domain && $role && $name) { @@ -10203,6 +10236,14 @@ sub get_dns { my ($lonid) = @_; return $internetdom{$lonid}; } + + sub is_LC_dns { + &load_hosts_tab() if (!$loaded); + + my ($hostname) = @_; + return exists($LC_dns_serv{$hostname}); + } + } {