--- loncom/lonnet/perl/lonnet.pm 2011/03/10 23:51:52 1.1056.4.24 +++ loncom/lonnet/perl/lonnet.pm 2011/09/15 21:37:30 1.1056.4.30 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1056.4.24 2011/03/10 23:51:52 raeburn Exp $ +# $Id: lonnet.pm,v 1.1056.4.30 2011/09/15 21:37:30 raeburn 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)) { @@ -808,7 +831,7 @@ sub compare_server_load { my $userloadans = &reply('userload',$try_server); if ($loadans !~ /\d/ && $userloadans !~ /\d/) { - return; #didn't get a number from the server + return ($spare_server, $lowest_load); #didn't get a number from the server } my $load; @@ -1010,15 +1033,19 @@ sub can_host_session { } if ($canhost) { if (ref($hostedsessions) eq 'HASH') { + my $uprimary_id = &Apache::lonnet::domain($udom,'primary'); + my $uint_dom = &Apache::lonnet::internet_dom($uprimary_id); if (ref($hostedsessions->{'excludedomain'}) eq 'ARRAY') { - if (grep(/^\Q$udom\E$/,@{$hostedsessions->{'excludedomain'}})) { + if (($uint_dom ne '') && + (grep(/^\Q$uint_dom\E$/,@{$hostedsessions->{'excludedomain'}}))) { $canhost = 0; } else { $canhost = 1; } } if (ref($hostedsessions->{'includedomain'}) eq 'ARRAY') { - if (grep(/^\Q$udom\E$/,@{$hostedsessions->{'includedomain'}})) { + if (($uint_dom ne '') && + (grep(/^\Q$uint_dom\E$/,@{$hostedsessions->{'includedomain'}}))) { $canhost = 1; } else { $canhost = 0; @@ -6705,6 +6732,13 @@ sub assignrole { return 'refused'; } } + } elsif ($role eq 'au') { + if ($url ne '/'.$udom.'/') { + &logthis('Attempt by '.$env{'user.name'}.':'.$env{'user.domain'}. + ' to assign author role for '.$uname.':'.$udom. + ' in domain: '.$url.' refused (wrong domain).'); + return 'refused'; + } } $mrole=$role; } @@ -8578,7 +8612,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/}) @@ -8620,7 +8654,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); @@ -10062,13 +10097,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) { @@ -10204,6 +10245,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}); + } + } {