--- loncom/lonnet/perl/lonnet.pm 2011/02/24 23:55:58 1.1104 +++ loncom/lonnet/perl/lonnet.pm 2011/06/07 17:42:29 1.1112 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1104 2011/02/24 23:55:58 raeburn Exp $ +# $Id: lonnet.pm,v 1.1112 2011/06/07 17:42:29 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)) { @@ -1976,20 +1999,29 @@ sub getversion { sub currentversion { my $fname=shift; - my ($result,$cached)=&is_cached_new('resversion',$fname); - if (defined($cached)) { return $result; } my $author=$fname; $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/; my ($udom,$uname)=split(/\//,$author); - my $home=homeserver($uname,$udom); + my $home=&homeserver($uname,$udom); if ($home eq 'no_host') { return -1; } - my $answer=reply("currentversion:$fname",$home); + my $answer=&reply("currentversion:$fname",$home); if (($answer eq 'con_lost') || ($answer eq 'rejected')) { return -1; } - return &do_cache_new('resversion',$fname,$answer,600); + return $answer; +} + +# +# Return special version number of resource if set by override, empty otherwise +# +sub usedversion { + my $fname=shift; + unless ($fname) { $fname=$env{'request.uri'}; } + my ($urlversion)=($fname=~/\.(\d+)\.\w+$/); + if ($urlversion) { return $urlversion; } + return ''; } # ----------------------------- Subscribe to a resource, return URL if possible @@ -7292,8 +7324,8 @@ sub store_userdata { $namevalue.=&escape($key).'='.&freeze_escape($$storehash{$key}).'&'; } $namevalue=~s/\&$//; - $result = &reply("store:$env{'user.domain'}:$env{'user.name'}:". - "$namespace:$datakey:$namevalue",$uhome); + $result = &reply("store:$udom:$uname:$namespace:$datakey:". + $namevalue,$uhome); } } else { $result = 'error: data to store was not a hash reference'; @@ -8521,7 +8553,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 +8599,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); @@ -10061,13 +10094,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 +10242,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}); + } + } {