version 1.1056.4.21, 2011/01/25 09:56:17
|
version 1.1056.4.26, 2011/06/03 00:31:30
|
Line 196 sub get_server_timezone {
|
Line 196 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 { |
sub get_server_loncaparev { |
my ($dom,$lonhost,$ignore_cache,$caller) = @_; |
my ($dom,$lonhost,$ignore_cache,$caller) = @_; |
if (defined($lonhost)) { |
if (defined($lonhost)) { |
Line 752 sub overloaderror {
|
Line 775 sub overloaderror {
|
# ------------------------------ Find server with least workload from spare.tab |
# ------------------------------ Find server with least workload from spare.tab |
|
|
sub spareserver { |
sub spareserver { |
my ($loadpercent,$userloadpercent,$want_server_name) = @_; |
my ($loadpercent,$userloadpercent,$want_server_name,$udom) = @_; |
my $spare_server; |
my $spare_server; |
if ($userloadpercent !~ /\d/) { $userloadpercent=0; } |
if ($userloadpercent !~ /\d/) { $userloadpercent=0; } |
my $lowest_load=($loadpercent > $userloadpercent) ? $loadpercent |
my $lowest_load=($loadpercent > $userloadpercent) ? $loadpercent |
: $userloadpercent; |
: $userloadpercent; |
my ($uint_dom,$remotesessions); |
my ($uint_dom,$remotesessions); |
if ($env{'user.domain'}) { |
if (($udom ne '') && (&domain($udom) ne '')) { |
my $uprimary_id = &Apache::lonnet::domain($env{'user.domain'},'primary'); |
my $uprimary_id = &Apache::lonnet::domain($udom,'primary'); |
$uint_dom = &Apache::lonnet::internet_dom($uprimary_id); |
$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'}; |
$remotesessions = $udomdefaults{'remotesessions'}; |
} |
} |
foreach my $try_server (@{ $spareid{'primary'} }) { |
foreach my $try_server (@{ $spareid{'primary'} }) { |
if ($uint_dom) { |
if ($uint_dom) { |
next unless (&spare_can_host($env{'user.domain'},$uint_dom, |
next unless (&spare_can_host($udom,$uint_dom,$remotesessions, |
$remotesessions,$try_server)); |
$try_server)); |
} |
} |
($spare_server, $lowest_load) = |
($spare_server, $lowest_load) = |
&compare_server_load($try_server, $spare_server, $lowest_load); |
&compare_server_load($try_server, $spare_server, $lowest_load); |
Line 778 sub spareserver {
|
Line 801 sub spareserver {
|
if (!$found_server) { |
if (!$found_server) { |
foreach my $try_server (@{ $spareid{'default'} }) { |
foreach my $try_server (@{ $spareid{'default'} }) { |
if ($uint_dom) { |
if ($uint_dom) { |
next unless (&spare_can_host($env{'user.domain'},$uint_dom, |
next unless (&spare_can_host($udom,$uint_dom,$remotesessions, |
$remotesessions,$try_server)); |
$try_server)); |
} |
} |
($spare_server, $lowest_load) = |
($spare_server, $lowest_load) = |
&compare_server_load($try_server, $spare_server, $lowest_load); |
&compare_server_load($try_server, $spare_server, $lowest_load); |
Line 5754 sub allowed {
|
Line 5777 sub allowed {
|
my $unamedom=$env{'user.name'}.':'.$env{'user.domain'}; |
my $unamedom=$env{'user.name'}.':'.$env{'user.domain'}; |
if ($env{'course.'.$env{'request.course.id'}.'.'.$priv.'.roles.denied'} |
if ($env{'course.'.$env{'request.course.id'}.'.'.$priv.'.roles.denied'} |
=~/\Q$rolecode\E/) { |
=~/\Q$rolecode\E/) { |
if ($priv ne 'pch') { |
if (($priv ne 'pch') && ($priv ne 'plc')) { |
&logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.':'. |
&logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.':'. |
'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode.' in '. |
'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode.' in '. |
$env{'request.course.id'}); |
$env{'request.course.id'}); |
Line 5764 sub allowed {
|
Line 5787 sub allowed {
|
|
|
if ($env{'course.'.$env{'request.course.id'}.'.'.$priv.'.users.denied'} |
if ($env{'course.'.$env{'request.course.id'}.'.'.$priv.'.users.denied'} |
=~/\Q$unamedom\E/) { |
=~/\Q$unamedom\E/) { |
if ($priv ne 'pch') { |
if (($priv ne 'pch') && ($priv ne 'plc')) { |
&logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}. |
&logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}. |
'Denied by user: '.$priv.' for '.$uri.' as '.$unamedom.' in '. |
'Denied by user: '.$priv.' for '.$uri.' as '.$unamedom.' in '. |
$env{'request.course.id'}); |
$env{'request.course.id'}); |
Line 5778 sub allowed {
|
Line 5801 sub allowed {
|
if ($thisallowed=~/R/) { |
if ($thisallowed=~/R/) { |
my $rolecode=(split(/\./,$env{'request.role'}))[0]; |
my $rolecode=(split(/\./,$env{'request.role'}))[0]; |
if (&metadata($uri,'roledeny')=~/\Q$rolecode\E/) { |
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'}.':'. |
&logthis($env{'user.domain'}.':'.$env{'user.name'}.':'.$env{'user.home'}.':'. |
'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode); |
'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode); |
} |
} |
Line 7350 sub store_userdata {
|
Line 7373 sub store_userdata {
|
$namevalue.=&escape($key).'='.&freeze_escape($$storehash{$key}).'&'; |
$namevalue.=&escape($key).'='.&freeze_escape($$storehash{$key}).'&'; |
} |
} |
$namevalue=~s/\&$//; |
$namevalue=~s/\&$//; |
$result = &reply("store:$env{'user.domain'}:$env{'user.name'}:". |
$result = &reply("store:$udom:$uname:$namespace:$datakey:". |
"$namespace:$datakey:$namevalue",$uhome); |
$namevalue,$uhome); |
} |
} |
} else { |
} else { |
$result = 'error: data to store was not a hash reference'; |
$result = 'error: data to store was not a hash reference'; |
Line 8578 sub metadata {
|
Line 8601 sub metadata {
|
if (($uri eq '') || |
if (($uri eq '') || |
(($uri =~ m|^/*adm/|) && |
(($uri =~ m|^/*adm/|) && |
($uri !~ m|^adm/includes|) && ($uri !~ m|/bulletinboard$|)) || |
($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; |
return undef; |
} |
} |
if (($uri =~ /^~/ || $uri =~ m{home/$match_username/public_html/}) |
if (($uri =~ /^~/ || $uri =~ m{home/$match_username/public_html/}) |
Line 8620 sub metadata {
|
Line 8643 sub metadata {
|
&Apache::lonnet::ssi_body($which, |
&Apache::lonnet::ssi_body($which, |
('grade_target' => 'meta')); |
('grade_target' => 'meta')); |
$cachetime = 1; # only want this cached in the child not long term |
$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)); |
my $file=&filelocation('',&clutter($filename)); |
#push(@{$metaentry{$uri.'.file'}},$file); |
#push(@{$metaentry{$uri.'.file'}},$file); |
$metastring=&getfile($file); |
$metastring=&getfile($file); |
Line 10062 sub get_dns {
|
Line 10086 sub get_dns {
|
my $loaded; |
my $loaded; |
my %name_to_host; |
my %name_to_host; |
my %internetdom; |
my %internetdom; |
|
my %LC_dns_serv; |
|
|
sub parse_hosts_tab { |
sub parse_hosts_tab { |
my ($file) = @_; |
my ($file) = @_; |
foreach my $configline (@$file) { |
foreach my $configline (@$file) { |
next if ($configline =~ /^(\#|\s*$ )/x); |
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); |
my ($id,$domain,$role,$name,$protocol,$intdom)=split(/:/,$configline); |
$name=~s/\s//g; |
$name=~s/\s//g; |
if ($id && $domain && $role && $name) { |
if ($id && $domain && $role && $name) { |