--- loncom/lonnet/perl/lonnet.pm 2011/01/11 22:36:11 1.1056.4.19
+++ loncom/lonnet/perl/lonnet.pm 2011/06/13 14:09:26 1.1056.4.27
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.1056.4.19 2011/01/11 22:36:11 raeburn Exp $
+# $Id: lonnet.pm,v 1.1056.4.27 2011/06/13 14:09:26 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)) {
@@ -752,22 +775,22 @@ sub overloaderror {
# ------------------------------ Find server with least workload from spare.tab
sub spareserver {
- my ($loadpercent,$userloadpercent,$want_server_name) = @_;
+ my ($loadpercent,$userloadpercent,$want_server_name,$udom) = @_;
my $spare_server;
if ($userloadpercent !~ /\d/) { $userloadpercent=0; }
my $lowest_load=($loadpercent > $userloadpercent) ? $loadpercent
: $userloadpercent;
my ($uint_dom,$remotesessions);
- if ($env{'user.domain'}) {
- my $uprimary_id = &Apache::lonnet::domain($env{'user.domain'},'primary');
+ if (($udom ne '') && (&domain($udom) ne '')) {
+ my $uprimary_id = &Apache::lonnet::domain($udom,'primary');
$uint_dom = &Apache::lonnet::internet_dom($uprimary_id);
- my %udomdefaults = &Apache::lonnet::get_domain_defaults($env{'user.domain'});
+ my %udomdefaults = &Apache::lonnet::get_domain_defaults($udom);
$remotesessions = $udomdefaults{'remotesessions'};
}
foreach my $try_server (@{ $spareid{'primary'} }) {
if ($uint_dom) {
- next unless (&spare_can_host($env{'user.domain'},$uint_dom,
- $remotesessions,$try_server));
+ next unless (&spare_can_host($udom,$uint_dom,$remotesessions,
+ $try_server));
}
($spare_server, $lowest_load) =
&compare_server_load($try_server, $spare_server, $lowest_load);
@@ -778,8 +801,8 @@ sub spareserver {
if (!$found_server) {
foreach my $try_server (@{ $spareid{'default'} }) {
if ($uint_dom) {
- next unless (&spare_can_host($env{'user.domain'},$uint_dom,
- $remotesessions,$try_server));
+ next unless (&spare_can_host($udom,$uint_dom,$remotesessions,
+ $try_server));
}
($spare_server, $lowest_load) =
&compare_server_load($try_server, $spare_server, $lowest_load);
@@ -5754,7 +5777,7 @@ sub allowed {
my $unamedom=$env{'user.name'}.':'.$env{'user.domain'};
if ($env{'course.'.$env{'request.course.id'}.'.'.$priv.'.roles.denied'}
=~/\Q$rolecode\E/) {
- if ($priv ne 'pch') {
+ if (($priv ne 'pch') && ($priv ne 'plc')) {
&logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.':'.
'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode.' in '.
$env{'request.course.id'});
@@ -5764,7 +5787,7 @@ sub allowed {
if ($env{'course.'.$env{'request.course.id'}.'.'.$priv.'.users.denied'}
=~/\Q$unamedom\E/) {
- if ($priv ne 'pch') {
+ if (($priv ne 'pch') && ($priv ne 'plc')) {
&logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.
'Denied by user: '.$priv.' for '.$uri.' as '.$unamedom.' in '.
$env{'request.course.id'});
@@ -5778,7 +5801,7 @@ sub allowed {
if ($thisallowed=~/R/) {
my $rolecode=(split(/\./,$env{'request.role'}))[0];
if (&metadata($uri,'roledeny')=~/\Q$rolecode\E/) {
- if ($priv ne 'pch') {
+ if (($priv ne 'pch') && ($priv ne 'plc')) {
&logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.':'.
'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode);
}
@@ -7350,8 +7373,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';
@@ -8578,7 +8601,7 @@ sub metadata {
if (($uri eq '') ||
(($uri =~ m|^/*adm/|) &&
($uri !~ m|^adm/includes|) && ($uri !~ m|/bulletinboard$|)) ||
- ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ /^\*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 +8643,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);
@@ -8968,7 +8992,8 @@ sub symbverify {
}
my $ids=$bighash{'ids_'.&clutter($thisurl)};
unless ($ids) {
- $ids=$bighash{'ids_/'.$thisurl};
+ my $idkey = 'ids_'.($thisurl =~ m{^/}? '' : '/').$thisurl;
+ $ids=$bighash{$idkey};
}
if ($ids) {
# ------------------------------------------------------------------- Has ID(s)
@@ -8981,7 +9006,8 @@ sub symbverify {
&symbclean(&declutter($bighash{'map_id_'.$mapid}).'___'.$resid.'___'.$thisfn)
eq $symb) {
if (($env{'request.role.adv'}) ||
- $bighash{'encrypted_'.$id} eq $env{'request.enc'}) {
+ ($bighash{'encrypted_'.$id} eq $env{'request.enc'}) ||
+ ($thisurl eq '/adm/navmaps')) {
$okay=1;
}
}
@@ -10060,13 +10086,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) {
@@ -10202,6 +10234,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});
+ }
+
}
{