--- loncom/lonnet/perl/lonnet.pm 2013/01/03 19:59:47 1.1172.2.16 +++ loncom/lonnet/perl/lonnet.pm 2013/02/02 03:30:24 1.1172.2.17 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1172.2.16 2013/01/03 19:59:47 raeburn Exp $ +# $Id: lonnet.pm,v 1.1172.2.17 2013/02/02 03:30:24 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -11513,12 +11513,12 @@ sub goodbye { } sub get_dns { - my ($url,$func,$ignore_cache) = @_; + my ($url,$func,$ignore_cache,$nocache,$hashref) = @_; if (!$ignore_cache) { my ($content,$cached)= &Apache::lonnet::is_cached_new('dns',$url); if ($cached) { - &$func($content); + &$func($content,$hashref); return; } } @@ -11543,8 +11543,10 @@ sub get_dns { delete($alldns{$dns}); next if ($response->is_error()); my @content = split("\n",$response->content); - &Apache::lonnet::do_cache_new('dns',$url,\@content,30*24*60*60); - &$func(\@content); + unless ($nocache) { + &Apache::lonnet::do_cache_new('dns',$url,\@content,30*24*60*60); + } + &$func(\@content,$hashref); return; } close($config); @@ -11552,9 +11554,62 @@ sub get_dns { &logthis("unable to contact DNS defaulting to on disk file dns_$which.tab\n"); open($config,"<$perlvar{'lonTabDir'}/dns_$which.tab"); my @content = <$config>; - &$func(\@content); + &$func(\@content,$hashref); + return; +} + +# ------------------------------------------------------Get DNS checksums file +sub parse_dns_checksums_tab { + my ($lines,$hashref) = @_; + my $machine_dom = &Apache::lonnet::host_domain($perlvar{'lonHostID'}); + my $loncaparev = &get_server_loncaparev($machine_dom); + my ($release,$timestamp) = split(/\-/,$loncaparev); + my (%chksum,%revnum); + if (ref($lines) eq 'ARRAY') { + chomp(@{$lines}); + my $versions = shift(@{$lines}); + my %supported; + if ($versions =~ /^VERSIONS\:([\w\.\,]+)$/) { + my $releaseslist = $1; + if ($releaseslist =~ /,/) { + map { $supported{$_} = 1; } split(/,/,$releaseslist); + } elsif ($releaseslist) { + $supported{$releaseslist} = 1; + } + } + if ($supported{$release}) { + my $matchthis = 0; + foreach my $line (@{$lines}) { + if ($line =~ /^(\d[\w\.]+)$/) { + if ($matchthis) { + last; + } elsif ($1 eq $release) { + $matchthis = 1; + } + } elsif ($matchthis) { + my ($file,$version,$shasum) = split(/,/,$line); + $chksum{$file} = $shasum; + $revnum{$file} = $version; + } + } + if (ref($hashref) eq 'HASH') { + %{$hashref} = ( + sums => \%chksum, + versions => \%revnum, + ); + } + } + } return; } + +sub fetch_dns_checksums { + my %checksums; + &get_dns('/adm/dns/checksums',\&parse_dns_checksums_tab,1,1, + \%checksums); + return \%checksums; +} + # ------------------------------------------------------------ Read domain file { my $loaded; @@ -12737,7 +12792,7 @@ returns the data handle =item * -symbverify($symb,$thisfn,$ecstate) : verifies that $symb actually exists +symbverify($symb,$thisfn,$encstate) : verifies that $symb actually exists and is a possible symb for the URL in $thisfn, and if is an encrypted resource that the user accessed using /enc/ returns a 1 on success, 0 on failure, user must be in a course, as it assumes the existence of