version 1.669, 2005/10/27 19:47:39
|
version 1.673, 2005/10/31 19:32:19
|
Line 166 sub reply {
|
Line 166 sub reply {
|
unless (defined($hostname{$server})) { return 'no_such_host'; } |
unless (defined($hostname{$server})) { return 'no_such_host'; } |
my $answer=subreply($cmd,$server); |
my $answer=subreply($cmd,$server); |
if (($answer=~/^refused/) || ($answer=~/^rejected/)) { |
if (($answer=~/^refused/) || ($answer=~/^rejected/)) { |
&logthis("<font color=blue>WARNING:". |
&logthis("<font color=\"blue\">WARNING:". |
" $cmd to $server returned $answer</font>"); |
" $cmd to $server returned $answer</font>"); |
} |
} |
return $answer; |
return $answer; |
Line 190 sub reconlonc {
|
Line 190 sub reconlonc {
|
sleep 5; |
sleep 5; |
if (-e "$peerfile") { return; } |
if (-e "$peerfile") { return; } |
&logthis( |
&logthis( |
"<font color=blue>WARNING: $peerfile still not there, giving up</font>"); |
"<font color=\"blue\">WARNING: $peerfile still not there, giving up</font>"); |
} else { |
} else { |
&logthis( |
&logthis( |
"<font color=blue>WARNING:". |
"<font color=\"blue\">WARNING:". |
" lonc at pid $loncpid not responding, giving up</font>"); |
" lonc at pid $loncpid not responding, giving up</font>"); |
} |
} |
} else { |
} else { |
&logthis('<font color=blue>WARNING: lonc not running, giving up</font>'); |
&logthis('<font color="blue">WARNING: lonc not running, giving up</font>'); |
} |
} |
} |
} |
|
|
Line 206 sub reconlonc {
|
Line 206 sub reconlonc {
|
sub critical { |
sub critical { |
my ($cmd,$server)=@_; |
my ($cmd,$server)=@_; |
unless ($hostname{$server}) { |
unless ($hostname{$server}) { |
&logthis("<font color=blue>WARNING:". |
&logthis("<font color=\"blue\">WARNING:". |
" Critical message to unknown server ($server)</font>"); |
" Critical message to unknown server ($server)</font>"); |
return 'no_such_host'; |
return 'no_such_host'; |
} |
} |
Line 240 sub critical {
|
Line 240 sub critical {
|
} |
} |
chomp($wcmd); |
chomp($wcmd); |
if ($wcmd eq $cmd) { |
if ($wcmd eq $cmd) { |
&logthis("<font color=blue>WARNING: ". |
&logthis("<font color=\"blue\">WARNING: ". |
"Connection buffer $dfilename: $cmd</font>"); |
"Connection buffer $dfilename: $cmd</font>"); |
&logperm("D:$server:$cmd"); |
&logperm("D:$server:$cmd"); |
return 'con_delayed'; |
return 'con_delayed'; |
} else { |
} else { |
&logthis("<font color=red>CRITICAL:" |
&logthis("<font color=\"red\">CRITICAL:" |
." Critical connection failed: $server $cmd</font>"); |
." Critical connection failed: $server $cmd</font>"); |
&logperm("F:$server:$cmd"); |
&logperm("F:$server:$cmd"); |
return 'con_failed'; |
return 'con_failed'; |
Line 290 sub appenv {
|
Line 290 sub appenv {
|
my %newenv=@_; |
my %newenv=@_; |
foreach (keys %newenv) { |
foreach (keys %newenv) { |
if (($newenv{$_}=~/^user\.role/) || ($newenv{$_}=~/^user\.priv/)) { |
if (($newenv{$_}=~/^user\.role/) || ($newenv{$_}=~/^user\.priv/)) { |
&logthis("<font color=blue>WARNING: ". |
&logthis("<font color=\"blue\">WARNING: ". |
"Attempt to modify environment ".$_." to ".$newenv{$_} |
"Attempt to modify environment ".$_." to ".$newenv{$_} |
.'</font>'); |
.'</font>'); |
delete($newenv{$_}); |
delete($newenv{$_}); |
Line 304 sub appenv {
|
Line 304 sub appenv {
|
return 'error: '.$!; |
return 'error: '.$!; |
} |
} |
unless (flock($lockfh,LOCK_EX)) { |
unless (flock($lockfh,LOCK_EX)) { |
&logthis("<font color=blue>WARNING: ". |
&logthis("<font color=\"blue\">WARNING: ". |
'Could not obtain exclusive lock in appenv: '.$!); |
'Could not obtain exclusive lock in appenv: '.$!); |
close($lockfh); |
close($lockfh); |
return 'error: '.$!; |
return 'error: '.$!; |
Line 349 sub delenv {
|
Line 349 sub delenv {
|
my $delthis=shift; |
my $delthis=shift; |
my %newenv=(); |
my %newenv=(); |
if (($delthis=~/user\.role/) || ($delthis=~/user\.priv/)) { |
if (($delthis=~/user\.role/) || ($delthis=~/user\.priv/)) { |
&logthis("<font color=blue>WARNING: ". |
&logthis("<font color=\"blue\">WARNING: ". |
"Attempt to delete from environment ".$delthis); |
"Attempt to delete from environment ".$delthis); |
return 'error'; |
return 'error'; |
} |
} |
Line 360 sub delenv {
|
Line 360 sub delenv {
|
return 'error'; |
return 'error'; |
} |
} |
unless (flock($fh,LOCK_SH)) { |
unless (flock($fh,LOCK_SH)) { |
&logthis("<font color=blue>WARNING: ". |
&logthis("<font color=\"blue\">WARNING: ". |
'Could not obtain shared lock in delenv: '.$!); |
'Could not obtain shared lock in delenv: '.$!); |
close($fh); |
close($fh); |
return 'error: '.$!; |
return 'error: '.$!; |
Line 374 sub delenv {
|
Line 374 sub delenv {
|
return 'error'; |
return 'error'; |
} |
} |
unless (flock($fh,LOCK_EX)) { |
unless (flock($fh,LOCK_EX)) { |
&logthis("<font color=blue>WARNING: ". |
&logthis("<font color=\"blue\">WARNING: ". |
'Could not obtain exclusive lock in delenv: '.$!); |
'Could not obtain exclusive lock in delenv: '.$!); |
close($fh); |
close($fh); |
return 'error: '.$!; |
return 'error: '.$!; |
Line 443 sub overloaderror {
|
Line 443 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) = @_; |
my ($loadpercent,$userloadpercent,$want_server_name) = @_; |
my $tryserver; |
my $tryserver; |
my $spareserver=''; |
my $spareserver=''; |
if ($userloadpercent !~ /\d/) { $userloadpercent=0; } |
if ($userloadpercent !~ /\d/) { $userloadpercent=0; } |
my $lowestserver=$loadpercent > $userloadpercent? |
my $lowestserver=$loadpercent > $userloadpercent? |
$loadpercent : $userloadpercent; |
$loadpercent : $userloadpercent; |
foreach $tryserver (keys %spareid) { |
foreach $tryserver (keys(%spareid)) { |
my $loadans=reply('load',$tryserver); |
my $loadans=&reply('load',$tryserver); |
my $userloadans=reply('userload',$tryserver); |
my $userloadans=&reply('userload',$tryserver); |
if ($loadans !~ /\d/ && $userloadans !~ /\d/) { |
if ($loadans !~ /\d/ && $userloadans !~ /\d/) { |
next; #didn't get a number from the server |
next; #didn't get a number from the server |
} |
} |
Line 468 sub spareserver {
|
Line 468 sub spareserver {
|
$answer = $userloadans; |
$answer = $userloadans; |
} |
} |
if (($answer =~ /\d/) && ($answer<$lowestserver)) { |
if (($answer =~ /\d/) && ($answer<$lowestserver)) { |
$spareserver="http://$hostname{$tryserver}"; |
if ($want_server_name) { |
|
$spareserver=$tryserver; |
|
} else { |
|
$spareserver="http://$hostname{$tryserver}"; |
|
} |
$lowestserver=$answer; |
$lowestserver=$answer; |
} |
} |
} |
} |
Line 1060 sub repcopy {
|
Line 1064 sub repcopy {
|
if ($response->is_error()) { |
if ($response->is_error()) { |
unlink($transname); |
unlink($transname); |
my $message=$response->status_line; |
my $message=$response->status_line; |
&logthis("<font color=blue>WARNING:" |
&logthis("<font color=\"blue\">WARNING:" |
." LWP get: $message: $filename</font>"); |
." LWP get: $message: $filename</font>"); |
return 'unavailable'; |
return 'unavailable'; |
} else { |
} else { |
Line 1070 sub repcopy {
|
Line 1074 sub repcopy {
|
if ($mresponse->is_error()) { |
if ($mresponse->is_error()) { |
unlink($filename.'.meta'); |
unlink($filename.'.meta'); |
&logthis( |
&logthis( |
"<font color=yellow>INFO: No metadata: $filename</font>"); |
"<font color=\"yellow\">INFO: No metadata: $filename</font>"); |
} |
} |
} |
} |
rename($transname,$filename); |
rename($transname,$filename); |
Line 1538 sub flushcourselogs {
|
Line 1542 sub flushcourselogs {
|
} else { |
} else { |
&logthis('Failed to flush log buffer for '.$crsid); |
&logthis('Failed to flush log buffer for '.$crsid); |
if (length($courselogs{$crsid})>40000) { |
if (length($courselogs{$crsid})>40000) { |
&logthis("<font color=blue>WARNING: Buffer for ".$crsid. |
&logthis("<font color=\"blue\">WARNING: Buffer for ".$crsid. |
" exceeded maximum size, deleting.</font>"); |
" exceeded maximum size, deleting.</font>"); |
delete $courselogs{$crsid}; |
delete $courselogs{$crsid}; |
} |
} |
Line 1949 sub checkout {
|
Line 1953 sub checkout {
|
$now.'&'.$ENV{'REMOTE_ADDR'}); |
$now.'&'.$ENV{'REMOTE_ADDR'}); |
my $token=&reply('tmpput:'.$infostr,$lonhost); |
my $token=&reply('tmpput:'.$infostr,$lonhost); |
if ($token=~/^error\:/) { |
if ($token=~/^error\:/) { |
&logthis("<font color=blue>WARNING: ". |
&logthis("<font color=\"blue\">WARNING: ". |
"Checkout tmpput failed ".$tudom.' - '.$tuname.' - '.$symb. |
"Checkout tmpput failed ".$tudom.' - '.$tuname.' - '.$symb. |
"</font>"); |
"</font>"); |
return ''; |
return ''; |
Line 1965 sub checkout {
|
Line 1969 sub checkout {
|
unless (&cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') { |
unless (&cstore(\%infohash,$symb,$tcrsid,$tudom,$tuname) eq 'ok') { |
return ''; |
return ''; |
} else { |
} else { |
&logthis("<font color=blue>WARNING: ". |
&logthis("<font color=\"blue\">WARNING: ". |
"Checkout cstore failed ".$tudom.' - '.$tuname.' - '.$symb. |
"Checkout cstore failed ".$tudom.' - '.$tuname.' - '.$symb. |
"</font>"); |
"</font>"); |
} |
} |
Line 1975 sub checkout {
|
Line 1979 sub checkout {
|
$token)) ne 'ok') { |
$token)) ne 'ok') { |
return ''; |
return ''; |
} else { |
} else { |
&logthis("<font color=blue>WARNING: ". |
&logthis("<font color=\"blue\">WARNING: ". |
"Checkout log failed ".$tudom.' - '.$tuname.' - '.$symb. |
"Checkout log failed ".$tudom.' - '.$tuname.' - '.$symb. |
"</font>"); |
"</font>"); |
} |
} |
Line 3102 sub allowed {
|
Line 3106 sub allowed {
|
# not allowing 'edit' access (editupload) to uploaded course docs |
# not allowing 'edit' access (editupload) to uploaded course docs |
if (($priv eq 'bre') && ($uri=~m|^uploaded/|)) { |
if (($priv eq 'bre') && ($uri=~m|^uploaded/|)) { |
$thisallowed=''; |
$thisallowed=''; |
my $refuri=$env{'httpref.'.$orguri}; |
my ($match)=&is_on_map($uri); |
if ($refuri) { |
if ($match) { |
if ($refuri =~ m|^/adm/|) { |
if ($env{'user.priv.'.$env{'request.role'}.'./'} |
$thisallowed='F'; |
=~/\Q$priv\E\&([^\:]*)/) { |
} else { |
$thisallowed.=$1; |
$refuri=&declutter($refuri); |
} |
my ($match) = &is_on_map($refuri); |
} else { |
if ($match) { |
my $refuri=$env{'httpref.'.$orguri}; |
|
if ($refuri) { |
|
if ($refuri =~ m|^/adm/|) { |
$thisallowed='F'; |
$thisallowed='F'; |
|
} else { |
|
$refuri=&declutter($refuri); |
|
my ($match) = &is_on_map($refuri); |
|
if ($match) { |
|
$thisallowed='F'; |
|
} |
} |
} |
} |
} |
} |
} |
} |
} |
|
|
# Full access at system, domain or course-wide level? Exit. |
# Full access at system, domain or course-wide level? Exit. |
Line 3281 sub allowed {
|
Line 3293 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/) { |
&log($env{'user.domain'},$env{'user.name'},$env{'user.host'}, |
&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'}); |
return ''; |
return ''; |
Line 3289 sub allowed {
|
Line 3301 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/) { |
&log($env{'user.domain'},$env{'user.name'},$env{'user.host'}, |
&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'}); |
return ''; |
return ''; |
Line 3301 sub allowed {
|
Line 3313 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/) { |
&log($env{'user.domain'},$env{'user.name'},$env{'user.host'}, |
&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); |
return ''; |
return ''; |
} |
} |
} |
} |
Line 4470 sub get_userresdata {
|
Line 4482 sub get_userresdata {
|
} |
} |
#error 2 occurs when the .db doesn't exist |
#error 2 occurs when the .db doesn't exist |
if ($tmp!~/error: 2 /) { |
if ($tmp!~/error: 2 /) { |
&logthis("<font color=blue>WARNING:". |
&logthis("<font color=\"blue\">WARNING:". |
" Trying to get resource data for ". |
" Trying to get resource data for ". |
$uname." at ".$udom.": ". |
$uname." at ".$udom.": ". |
$tmp."</font>"); |
$tmp."</font>"); |
Line 6114 $processmarker='_'.time.'_'.$perlvar{'lo
|
Line 6126 $processmarker='_'.time.'_'.$perlvar{'lo
|
$dumpcount=0; |
$dumpcount=0; |
|
|
&logtouch(); |
&logtouch(); |
&logthis('<font color=yellow>INFO: Read configuration</font>'); |
&logthis('<font color="yellow">INFO: Read configuration</font>'); |
$readit=1; |
$readit=1; |
{ |
{ |
use integer; |
use integer; |