version 1.1056.4.25, 2011/05/14 17:16:49
|
version 1.1056.4.33, 2011/10/19 16:36:02
|
Line 76 use HTTP::Date;
|
Line 76 use HTTP::Date;
|
use Image::Magick; |
use Image::Magick; |
|
|
use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir |
use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir |
$_64bit %env %protocol %loncaparevs %serverhomeIDs %needsrelease); |
$_64bit %env %protocol %loncaparevs %serverhomeIDs %needsrelease |
|
%managerstab); |
|
|
my (%badServerCache, $memcache, %courselogs, %accesshash, %domainrolehash, |
my (%badServerCache, $memcache, %courselogs, %accesshash, %domainrolehash, |
%userrolehash, $processmarker, $dumpcount, %coursedombuf, |
%userrolehash, $processmarker, $dumpcount, %coursedombuf, |
Line 831 sub compare_server_load {
|
Line 832 sub compare_server_load {
|
my $userloadans = &reply('userload',$try_server); |
my $userloadans = &reply('userload',$try_server); |
|
|
if ($loadans !~ /\d/ && $userloadans !~ /\d/) { |
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; |
my $load; |
Line 877 sub has_user_session {
|
Line 878 sub has_user_session {
|
# --------- determine least loaded server in a user's domain which allows login |
# --------- determine least loaded server in a user's domain which allows login |
|
|
sub choose_server { |
sub choose_server { |
my ($udom) = @_; |
my ($udom,$checkloginvia) = @_; |
my %domconfhash = &Apache::loncommon::get_domainconf($udom); |
my %domconfhash = &Apache::loncommon::get_domainconf($udom); |
my %servers = &get_servers($udom); |
my %servers = &get_servers($udom); |
my $lowest_load = 30000; |
my $lowest_load = 30000; |
my ($login_host,$hostname); |
my ($login_host,$hostname,$portal_path); |
foreach my $lonhost (keys(%servers)) { |
foreach my $lonhost (keys(%servers)) { |
my $loginvia = $domconfhash{$udom.'.login.loginvia_'.$lonhost}; |
my $loginvia; |
if ($loginvia eq '') { |
if ($checkloginvia) { |
|
$loginvia = $domconfhash{$udom.'.login.loginvia_'.$lonhost}; |
|
if ($loginvia) { |
|
my ($server,$path) = split(/:/,$loginvia); |
|
($login_host, $lowest_load) = |
|
&compare_server_load($lonhost, $login_host, $lowest_load); |
|
if ($login_host eq $server) { |
|
$portal_path = $path; |
|
} |
|
} else { |
|
($login_host, $lowest_load) = |
|
&compare_server_load($lonhost, $login_host, $lowest_load); |
|
if ($login_host eq $lonhost) { |
|
$portal_path = ''; |
|
} |
|
} |
|
} else { |
($login_host, $lowest_load) = |
($login_host, $lowest_load) = |
&compare_server_load($lonhost, $login_host, $lowest_load); |
&compare_server_load($lonhost, $login_host, $lowest_load); |
} |
} |
} |
} |
if ($login_host ne '') { |
if ($login_host ne '') { |
$hostname = $servers{$login_host}; |
$hostname = &hostname($login_host); |
} |
} |
return ($login_host,$hostname); |
return ($login_host,$hostname); |
} |
} |
Line 1033 sub can_host_session {
|
Line 1050 sub can_host_session {
|
} |
} |
if ($canhost) { |
if ($canhost) { |
if (ref($hostedsessions) eq 'HASH') { |
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 (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; |
$canhost = 0; |
} else { |
} else { |
$canhost = 1; |
$canhost = 1; |
} |
} |
} |
} |
if (ref($hostedsessions->{'includedomain'}) eq 'ARRAY') { |
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; |
$canhost = 1; |
} else { |
} else { |
$canhost = 0; |
$canhost = 0; |
Line 3694 sub hashref2str {
|
Line 3715 sub hashref2str {
|
$result.='='; |
$result.='='; |
#print("Got a ref of ".(ref($key))." skipping."); |
#print("Got a ref of ".(ref($key))." skipping."); |
} else { |
} else { |
if ($key) {$result.=&escape($key).'=';} else { last; } |
if (defined($key)) {$result.=&escape($key).'=';} else { last; } |
} |
} |
|
|
if(ref($hashref->{$key}) eq 'ARRAY') { |
if(ref($hashref->{$key}) eq 'ARRAY') { |
Line 6728 sub assignrole {
|
Line 6749 sub assignrole {
|
return 'refused'; |
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; |
$mrole=$role; |
} |
} |
Line 8601 sub metadata {
|
Line 8629 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 8643 sub metadata {
|
Line 8671 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 10001 sub get_dns {
|
Line 10030 sub get_dns {
|
while (%alldns) { |
while (%alldns) { |
my ($dns) = keys(%alldns); |
my ($dns) = keys(%alldns); |
my $ua=new LWP::UserAgent; |
my $ua=new LWP::UserAgent; |
|
$ua->timeout(30); |
my $request=new HTTP::Request('GET',"$alldns{$dns}://$dns$url"); |
my $request=new HTTP::Request('GET',"$alldns{$dns}://$dns$url"); |
my $response=$ua->request($request); |
my $response=$ua->request($request); |
delete($alldns{$dns}); |
delete($alldns{$dns}); |
Line 10233 sub get_dns {
|
Line 10263 sub get_dns {
|
my ($lonid) = @_; |
my ($lonid) = @_; |
return $internetdom{$lonid}; |
return $internetdom{$lonid}; |
} |
} |
|
|
|
sub is_LC_dns { |
|
&load_hosts_tab() if (!$loaded); |
|
|
|
my ($hostname) = @_; |
|
return exists($LC_dns_serv{$hostname}); |
|
} |
|
|
} |
} |
|
|
{ |
{ |
Line 10508 BEGIN {
|
Line 10546 BEGIN {
|
} |
} |
} |
} |
|
|
|
# ---------------------------------------------------------- Read managers table |
|
{ |
|
if (-e "$perlvar{'lonTabDir'}/managers.tab") { |
|
if (open(my $config,"<$perlvar{'lonTabDir'}/managers.tab")) { |
|
while (my $configline=<$config>) { |
|
chomp($configline); |
|
next if ($configline =~ /^\#/); |
|
if (($configline =~ /^[\w\-]+$/) || ($configline =~ /^[\w\-]+\:[\w\-]+$/)) { |
|
$managerstab{$configline} = 1; |
|
} |
|
} |
|
close($config); |
|
} |
|
} |
|
} |
|
|
# ------------- set up temporary directory |
# ------------- set up temporary directory |
{ |
{ |
$tmpdir = $perlvar{'lonDaemons'}.'/tmp/'; |
$tmpdir = $perlvar{'lonDaemons'}.'/tmp/'; |
Line 11401 splitting on '&', supports elements that
|
Line 11455 splitting on '&', supports elements that
|
|
|
=head2 Logging Routines |
=head2 Logging Routines |
|
|
=over 4 |
|
|
|
These routines allow one to make log messages in the lonnet.log and |
These routines allow one to make log messages in the lonnet.log and |
lonnet.perm logfiles. |
lonnet.perm logfiles. |
|
|
|
=over 4 |
|
|
=item * |
=item * |
|
|
logtouch() : make sure the logfile, lonnet.log, exists |
logtouch() : make sure the logfile, lonnet.log, exists |