version 1.161, 2003/11/11 12:39:14
|
version 1.168, 2003/12/22 12:01:54
|
Line 10
|
Line 10
|
# |
# |
# LON-CAPA is free software; you can redistribute it and/or modify |
# LON-CAPA is free software; you can redistribute it and/or modify |
# it under the terms of the GNU General Public License as published by |
# it under the terms of the GNU General Public License as published by |
# the Free Software Foundation; either version 2 of the License, or |
# the Free Software Foundation; either version 2 of the License, or |
# (at your option) any later version. |
# (at your option) any later version. |
# |
# |
# LON-CAPA is distributed in the hope that it will be useful, |
# LON-CAPA is distributed in the hope that it will be useful, |
Line 162 sub ReadManagerTable {
|
Line 162 sub ReadManagerTable {
|
|
|
# Clean out the old table first.. |
# Clean out the old table first.. |
|
|
foreach my $key (keys %managers) { |
foreach my $key (keys %managers) { |
delete $managers{$key}; |
delete $managers{$key}; |
} |
} |
|
|
my $tablename = $perlvar{'lonTabDir'}."/managers.tab"; |
my $tablename = $perlvar{'lonTabDir'}."/managers.tab"; |
if (!open (MANAGERS, $tablename)) { |
if (!open (MANAGERS, $tablename)) { |
logthis('<font color="red">No manager table. Nobody can manage!!</font>'); |
logthis('<font color="red">No manager table. Nobody can manage!!</font>'); |
return; |
return; |
} |
} |
while(my $host = <MANAGERS>) { |
while(my $host = <MANAGERS>) { |
chomp($host); |
chomp($host); |
if (!defined $hostip{$host}) { # This is a non cluster member |
if ($host =~ "^#") { # Comment line. |
|
logthis('<font color="green"> Skipping line: '. "$host</font>\n"); |
|
next; |
|
} |
|
if (!defined $hostip{$host}) { # This is a non cluster member |
# The entry is of the form: |
# The entry is of the form: |
# cluname:hostname |
# cluname:hostname |
# cluname - A 'cluster hostname' is needed in order to negotiate |
# cluname - A 'cluster hostname' is needed in order to negotiate |
# the host key. |
# the host key. |
# hostname- The dns name of the host. |
# hostname- The dns name of the host. |
# |
# |
|
my($cluname, $dnsname) = split(/:/, $host); |
my($cluname, $dnsname) = split(/:/, $host); |
|
open(MGRPIPE, "/usr/bin/host $dnsname |") || die "Can't make host pipeline"; |
my $ip = gethostbyname($dnsname); |
my $dnsinfo = <MGRPIPE>; |
if(defined($ip)) { # bad names don't deserve entry. |
chomp $dnsinfo; |
my $hostip = inet_ntoa($ip); |
close MGRPIPE; |
$managers{$hostip} = $cluname; |
my($jname, $jhas, $jaddress, $hostip) = split(/ /, $dnsinfo); |
logthis('<font color="green"> registering manager '. |
$managers{$hostip} = $cluname; |
"$dnsname as $cluname with $hostip </font>\n"); |
} else { |
} |
$managers{$hostip{$host}} = $host; # Use info from cluster tab if clumemeber |
} else { |
} |
logthis('<font color="green"> existing host'." $host</font>\n"); |
} |
$managers{$hostip{$host}} = $host; # Use info from cluster tab if clumemeber |
|
} |
|
} |
} |
} |
|
|
# |
# |
Line 205 sub ReadManagerTable {
|
Line 210 sub ReadManagerTable {
|
sub ValidManager { |
sub ValidManager { |
my $certificate = shift; |
my $certificate = shift; |
|
|
ReadManagerTable; |
return isManager; |
|
|
my $hostname = $hostid{$certificate}; |
|
|
|
|
|
if ($hostname ne undef) { |
|
if($managers{$hostname} ne undef) { |
|
&logthis('<font color="yellow">Authenticating manager'. |
|
" $hostname</font>"); |
|
return 1; |
|
} else { |
|
&logthis('<font color="red" failed manager authentication '. |
|
$hostname." is not a valid manager host</font>"); |
|
return 0; |
|
} |
|
} else { |
|
&logthis('<font color="red"> Failed manager authentication '. |
|
"$certificate </font>"); |
|
return 0; |
|
} |
|
} |
} |
# |
# |
# CopyFile: Called as part of the process of installing a |
# CopyFile: Called as part of the process of installing a |
Line 298 sub AdjustHostContents {
|
Line 284 sub AdjustHostContents {
|
my $adjusted; |
my $adjusted; |
my $me = $perlvar{'lonHostID'}; |
my $me = $perlvar{'lonHostID'}; |
|
|
foreach my $line (split(/\n/,$contents)) { |
foreach my $line (split(/\n/,$contents)) { |
if(!(($line eq "") || ($line =~ /^ *\#/) || ($line =~ /^ *$/))) { |
if(!(($line eq "") || ($line =~ /^ *\#/) || ($line =~ /^ *$/))) { |
chomp($line); |
chomp($line); |
my ($id,$domain,$role,$name,$ip,$maxcon,$idleto,$mincon)=split(/:/,$line); |
my ($id,$domain,$role,$name,$ip,$maxcon,$idleto,$mincon)=split(/:/,$line); |
if ($id eq $me) { |
if ($id eq $me) { |
open(PIPE, " /usr/bin/host $name |") || die "Cant' make host pipeline"; |
my $ip = gethostbyname($name); |
my $hostinfo = <PIPE>; |
my $ipnew = inet_ntoa($ip); |
close PIPE; |
$ip = $ipnew; |
|
|
my ($hostname, $has, $address, $ipnew) = split(/ /,$hostinfo); |
|
&logthis('<font color="green">'. |
|
"hostname = $hostname me = $me, name = $name actual ip = $ipnew </font>"); |
|
|
|
if ($hostname eq $name) { # Lookup succeeded.. |
|
&logthis('<font color="green"> look up ok <font>'); |
|
$ip = $ipnew; |
|
} else { |
|
&logthis('<font color="green"> Lookup failed: ' |
|
.$hostname." ne $name </font>"); |
|
} |
|
# Reconstruct the host line and append to adjusted: |
# Reconstruct the host line and append to adjusted: |
|
|
my $newline = "$id:$domain:$role:$name:$ip"; |
my $newline = "$id:$domain:$role:$name:$ip"; |
if($maxcon ne "") { # Not all hosts have loncnew tuning params |
if($maxcon ne "") { # Not all hosts have loncnew tuning params |
$newline .= ":$maxcon:$idleto:$mincon"; |
$newline .= ":$maxcon:$idleto:$mincon"; |
} |
} |
$adjusted .= $newline."\n"; |
$adjusted .= $newline."\n"; |
|
|
} else { # Not me, pass unmodified. |
} else { # Not me, pass unmodified. |
$adjusted .= $line."\n"; |
$adjusted .= $line."\n"; |
} |
} |
} else { # Blank or comment never re-written. |
} else { # Blank or comment never re-written. |
$adjusted .= $line."\n"; # Pass blanks and comments as is. |
$adjusted .= $line."\n"; # Pass blanks and comments as is. |
} |
} |
} |
} |
return $adjusted; |
return $adjusted; |
} |
} |
# |
# |
# InstallFile: Called to install an administrative file: |
# InstallFile: Called to install an administrative file: |
Line 502 sub ReinitProcess {
|
Line 476 sub ReinitProcess {
|
} |
} |
return 'ok'; |
return 'ok'; |
} |
} |
|
# Validate a line in a configuration file edit script: |
|
# Validation includes: |
|
# - Ensuring the command is valid. |
|
# - Ensuring the command has sufficient parameters |
|
# Parameters: |
|
# scriptline - A line to validate (\n has been stripped for what it's worth). |
|
# |
|
# Return: |
|
# 0 - Invalid scriptline. |
|
# 1 - Valid scriptline |
|
# NOTE: |
|
# Only the command syntax is checked, not the executability of the |
|
# command. |
|
# |
|
sub isValidEditCommand { |
|
my $scriptline = shift; |
|
|
|
# Line elements are pipe separated: |
|
|
|
my ($command, $key, $newline) = split(/\|/, $scriptline); |
|
&logthis('<font color="green"> isValideditCommand checking: '. |
|
"Command = '$command', Key = '$key', Newline = '$newline' </font>\n"); |
|
|
|
if ($command eq "delete") { |
|
# |
|
# key with no newline. |
|
# |
|
if( ($key eq "") || ($newline ne "")) { |
|
return 0; # Must have key but no newline. |
|
} else { |
|
return 1; # Valid syntax. |
|
} |
|
} elsif (($command eq "append") || ($command eq "replace")) { |
|
# |
|
# key and newline: |
|
# |
|
if (($key eq "") || ($newline eq "")) { |
|
return 0; |
|
} else { |
|
return 1; |
|
} |
|
} else { |
|
return 0; # Invalid command. |
|
} |
|
return 0; # Should not get here!!! |
|
} |
|
|
|
# |
|
# |
|
# Called to edit a configuration table file |
|
# Parameters: |
|
# request - The entire command/request sent by lonc or lonManage |
|
# Return: |
|
# The reply to send to the client. |
|
# |
|
sub EditFile { |
|
my $request = shift; |
|
|
|
# Split the command into it's pieces: edit:filetype:script |
|
|
|
my ($request, $filetype, $script) = split(/:/, $request,3); # : in script |
|
|
|
# Check the pre-coditions for success: |
|
|
|
if($request != "edit") { # Something is amiss afoot alack. |
|
return "error:edit request detected, but request != 'edit'\n"; |
|
} |
|
if( ($filetype ne "hosts") && |
|
($filetype ne "domain")) { |
|
return "error:edit requested with invalid file specifier: $filetype \n"; |
|
} |
|
|
|
# Split the edit script and check it's validity. |
|
|
|
my @scriptlines = split(/\n/, $script); # one line per element. |
|
my $linecount = scalar(@scriptlines); |
|
for(my $i = 0; $i < $linecount; $i++) { |
|
chomp($scriptlines[$i]); |
|
if(!isValidEditCommand($scriptlines[$i])) { |
|
return "error:edit with bad script line: '$scriptlines[$i]' \n"; |
|
} |
|
} |
|
|
|
# Execute the edit operation. |
|
|
|
|
|
return "ok\n"; |
|
} |
# |
# |
# Convert an error return code from lcpasswd to a string value. |
# Convert an error return code from lcpasswd to a string value. |
# |
# |
Line 532 sub catchexception {
|
Line 593 sub catchexception {
|
my ($error)=@_; |
my ($error)=@_; |
$SIG{'QUIT'}='DEFAULT'; |
$SIG{'QUIT'}='DEFAULT'; |
$SIG{__DIE__}='DEFAULT'; |
$SIG{__DIE__}='DEFAULT'; |
|
&status("Catching exception"); |
&logthis("<font color=red>CRITICAL: " |
&logthis("<font color=red>CRITICAL: " |
."ABNORMAL EXIT. Child $$ for server $thisserver died through " |
."ABNORMAL EXIT. Child $$ for server $thisserver died through " |
."a crash with this error msg->[$error]</font>"); |
."a crash with this error msg->[$error]</font>"); |
Line 542 sub catchexception {
|
Line 604 sub catchexception {
|
} |
} |
|
|
sub timeout { |
sub timeout { |
|
&status("Handling Timeout"); |
&logthis("<font color=ref>CRITICAL: TIME OUT ".$$."</font>"); |
&logthis("<font color=ref>CRITICAL: TIME OUT ".$$."</font>"); |
&catchexception('Timeout'); |
&catchexception('Timeout'); |
} |
} |
Line 598 my $children = 0; #
|
Line 661 my $children = 0; #
|
|
|
sub REAPER { # takes care of dead children |
sub REAPER { # takes care of dead children |
$SIG{CHLD} = \&REAPER; |
$SIG{CHLD} = \&REAPER; |
|
&status("Handling child death"); |
my $pid = wait; |
my $pid = wait; |
if (defined($children{$pid})) { |
if (defined($children{$pid})) { |
&logthis("Child $pid died"); |
&logthis("Child $pid died"); |
Line 606 sub REAPER { # ta
|
Line 670 sub REAPER { # ta
|
} else { |
} else { |
&logthis("Unknown Child $pid died"); |
&logthis("Unknown Child $pid died"); |
} |
} |
|
&status("Finished Handling child death"); |
} |
} |
|
|
sub HUNTSMAN { # signal handler for SIGINT |
sub HUNTSMAN { # signal handler for SIGINT |
|
&status("Killing children (INT)"); |
local($SIG{CHLD}) = 'IGNORE'; # we're going to kill our children |
local($SIG{CHLD}) = 'IGNORE'; # we're going to kill our children |
kill 'INT' => keys %children; |
kill 'INT' => keys %children; |
&logthis("Free socket: ".shutdown($server,2)); # free up socket |
&logthis("Free socket: ".shutdown($server,2)); # free up socket |
my $execdir=$perlvar{'lonDaemons'}; |
my $execdir=$perlvar{'lonDaemons'}; |
unlink("$execdir/logs/lond.pid"); |
unlink("$execdir/logs/lond.pid"); |
&logthis("<font color=red>CRITICAL: Shutting down</font>"); |
&logthis("<font color=red>CRITICAL: Shutting down</font>"); |
|
&status("Done killing children"); |
exit; # clean up with dignity |
exit; # clean up with dignity |
} |
} |
|
|
sub HUPSMAN { # signal handler for SIGHUP |
sub HUPSMAN { # signal handler for SIGHUP |
local($SIG{CHLD}) = 'IGNORE'; # we're going to kill our children |
local($SIG{CHLD}) = 'IGNORE'; # we're going to kill our children |
|
&status("Killing children for restart (HUP)"); |
kill 'INT' => keys %children; |
kill 'INT' => keys %children; |
&logthis("Free socket: ".shutdown($server,2)); # free up socket |
&logthis("Free socket: ".shutdown($server,2)); # free up socket |
&logthis("<font color=red>CRITICAL: Restarting</font>"); |
&logthis("<font color=red>CRITICAL: Restarting</font>"); |
my $execdir=$perlvar{'lonDaemons'}; |
my $execdir=$perlvar{'lonDaemons'}; |
unlink("$execdir/logs/lond.pid"); |
unlink("$execdir/logs/lond.pid"); |
|
&status("Restarting self (HUP)"); |
exec("$execdir/lond"); # here we go again |
exec("$execdir/lond"); # here we go again |
} |
} |
|
|
Line 686 sub ReloadApache {
|
Line 755 sub ReloadApache {
|
# now be honored. |
# now be honored. |
# |
# |
sub UpdateHosts { |
sub UpdateHosts { |
|
&status("Reload hosts.tab"); |
logthis('<font color="blue"> Updating connections </font>'); |
logthis('<font color="blue"> Updating connections </font>'); |
# |
# |
# The %children hash has the set of IP's we currently have children |
# The %children hash has the set of IP's we currently have children |
Line 710 sub UpdateHosts {
|
Line 780 sub UpdateHosts {
|
} |
} |
} |
} |
ReloadApache; |
ReloadApache; |
|
&status("Finished reloading hosts.tab"); |
} |
} |
|
|
|
|
sub checkchildren { |
sub checkchildren { |
|
&status("Checking on the children (sending signals)"); |
&initnewstatus(); |
&initnewstatus(); |
&logstatus(); |
&logstatus(); |
&logthis('Going to check on the children'); |
&logthis('Going to check on the children'); |
Line 728 sub checkchildren {
|
Line 800 sub checkchildren {
|
sleep 5; |
sleep 5; |
$SIG{ALRM} = sub { die "timeout" }; |
$SIG{ALRM} = sub { die "timeout" }; |
$SIG{__DIE__} = 'DEFAULT'; |
$SIG{__DIE__} = 'DEFAULT'; |
|
&status("Checking on the children (waiting for reports)"); |
foreach (sort keys %children) { |
foreach (sort keys %children) { |
unless (-e "$docdir/lon-status/londchld/$_.txt") { |
unless (-e "$docdir/lon-status/londchld/$_.txt") { |
eval { |
eval { |
Line 745 sub checkchildren {
|
Line 818 sub checkchildren {
|
} |
} |
$SIG{ALRM} = 'DEFAULT'; |
$SIG{ALRM} = 'DEFAULT'; |
$SIG{__DIE__} = \&catchexception; |
$SIG{__DIE__} = \&catchexception; |
|
&status("Finished checking children"); |
} |
} |
|
|
# --------------------------------------------------------------------- Logging |
# --------------------------------------------------------------------- Logging |
Line 787 sub Reply {
|
Line 861 sub Reply {
|
# ------------------------------------------------------------------ Log status |
# ------------------------------------------------------------------ Log status |
|
|
sub logstatus { |
sub logstatus { |
|
&status("Doing logging"); |
my $docdir=$perlvar{'lonDocRoot'}; |
my $docdir=$perlvar{'lonDocRoot'}; |
{ |
{ |
my $fh=IO::File->new(">>$docdir/lon-status/londstatus.txt"); |
my $fh=IO::File->new(">>$docdir/lon-status/londstatus.txt"); |
print $fh $$."\t".$currenthostid."\t".$status."\t".$lastlog."\n"; |
print $fh $$."\t".$currenthostid."\t".$status."\t".$lastlog."\n"; |
$fh->close(); |
$fh->close(); |
} |
} |
|
&status("Finished londstatus.txt"); |
{ |
{ |
my $fh=IO::File->new(">$docdir/lon-status/londchld/$$.txt"); |
my $fh=IO::File->new(">$docdir/lon-status/londchld/$$.txt"); |
print $fh $status."\n".$lastlog."\n".time; |
print $fh $status."\n".$lastlog."\n".time; |
$fh->close(); |
$fh->close(); |
} |
} |
|
&status("Finished logging"); |
} |
} |
|
|
sub initnewstatus { |
sub initnewstatus { |
Line 985 ReadHostTable;
|
Line 1062 ReadHostTable;
|
# along the connection. |
# along the connection. |
|
|
while (1) { |
while (1) { |
|
&status('Starting accept'); |
$client = $server->accept() or next; |
$client = $server->accept() or next; |
|
&status('Accepted '.$client.' off to spawn'); |
make_new_child($client); |
make_new_child($client); |
|
&status('Finished spawning'); |
} |
} |
|
|
sub make_new_child { |
sub make_new_child { |
Line 995 sub make_new_child {
|
Line 1075 sub make_new_child {
|
my $sigset; |
my $sigset; |
|
|
$client = shift; |
$client = shift; |
|
&status('Starting new child '.$client); |
&logthis('<font color="green"> Attempting to start child ('.$client. |
&logthis('<font color="green"> Attempting to start child ('.$client. |
")</font>"); |
")</font>"); |
# block signal for fork |
# block signal for fork |
Line 1223 sub make_new_child {
|
Line 1304 sub make_new_child {
|
} |
} |
#--------------------------------------------------------------------- reinit |
#--------------------------------------------------------------------- reinit |
} elsif($userinput =~ /^reinit/) { # Encoded and manager |
} elsif($userinput =~ /^reinit/) { # Encoded and manager |
if (($wasenc == 1) && isManager) { |
if (($wasenc == 1) && isManager) { |
my $cert = GetCertificate($userinput); |
my $cert = GetCertificate($userinput); |
if(ValidManager($cert)) { |
if(ValidManager($cert)) { |
chomp($userinput); |
chomp($userinput); |
my $reply = ReinitProcess($userinput); |
my $reply = ReinitProcess($userinput); |
print $client "$reply\n"; |
print $client "$reply\n"; |
|
} else { |
|
print $client "refused\n"; |
|
} |
} else { |
} else { |
print $client "refused\n"; |
Reply($client, "refused\n", $userinput); |
} |
} |
} else { |
#------------------------------------------------------------------------- edit |
Reply($client, "refused\n", $userinput); |
} elsif ($userinput =~ /^edit/) { # encoded and manager: |
|
if(($wasenc ==1) && (isManager)) { |
|
my $cert = GetCertificate($userinput); |
} |
if(ValidManager($cert)) { |
|
my($command, $filetype, $script) = split(/:/, $userinput); |
|
if (($filetype eq "hosts") || ($filetype eq "domain")) { |
|
if($script ne "") { |
|
Reply($client, EditFile($userinput)); |
|
} else { |
|
Reply($client,"refused\n",$userinput); |
|
} |
|
} else { |
|
Reply($client,"refused\n",$userinput); |
|
} |
|
} else { |
|
Reply($client,"refused\n",$userinput); |
|
} |
|
} else { |
|
Reply($client,"refused\n",$userinput); |
|
} |
# ------------------------------------------------------------------------ auth |
# ------------------------------------------------------------------------ auth |
} elsif ($userinput =~ /^auth/) { # Encoded and client only. |
} elsif ($userinput =~ /^auth/) { # Encoded and client only. |
if (($wasenc==1) && isClient) { |
if (($wasenc==1) && isClient) { |
my ($cmd,$udom,$uname,$upass)=split(/:/,$userinput); |
my ($cmd,$udom,$uname,$upass)=split(/:/,$userinput); |
chomp($upass); |
chomp($upass); |
Line 1707 sub make_new_child {
|
Line 1807 sub make_new_child {
|
Reply($client, "refused\n", $userinput); |
Reply($client, "refused\n", $userinput); |
|
|
} |
} |
|
# ------------------------------------------------------------------- inc |
|
} elsif ($userinput =~ /^inc:/) { |
|
if(isClient) { |
|
my ($cmd,$udom,$uname,$namespace,$what) |
|
=split(/:/,$userinput); |
|
$namespace=~s/\//\_/g; |
|
$namespace=~s/\W//g; |
|
if ($namespace ne 'roles') { |
|
chomp($what); |
|
my $proname=propath($udom,$uname); |
|
my $now=time; |
|
unless ($namespace=~/^nohist\_/) { |
|
my $hfh; |
|
if ( |
|
$hfh=IO::File->new(">>$proname/$namespace.hist") |
|
) { print $hfh "P:$now:$what\n"; } |
|
} |
|
my @pairs=split(/\&/,$what); |
|
my %hash; |
|
if (tie(%hash,'GDBM_File', |
|
"$proname/$namespace.db", |
|
&GDBM_WRCREAT(),0640)) { |
|
foreach my $pair (@pairs) { |
|
my ($key,$value)=split(/=/,$pair); |
|
# We could check that we have a number... |
|
if (! defined($value) || $value eq '') { |
|
$value = 1; |
|
} |
|
$hash{$key}+=$value; |
|
} |
|
if (untie(%hash)) { |
|
print $client "ok\n"; |
|
} else { |
|
print $client "error: ".($!+0) |
|
." untie(GDBM) failed ". |
|
"while attempting put\n"; |
|
} |
|
} else { |
|
print $client "error: ".($!) |
|
." tie(GDBM) Failed ". |
|
"while attempting put\n"; |
|
} |
|
} else { |
|
print $client "refused\n"; |
|
} |
|
} else { |
|
Reply($client, "refused\n", $userinput); |
|
|
|
} |
# -------------------------------------------------------------------- rolesput |
# -------------------------------------------------------------------- rolesput |
} elsif ($userinput =~ /^rolesput/) { |
} elsif ($userinput =~ /^rolesput/) { |
if(isClient) { |
if(isClient) { |
Line 2470 sub make_new_child {
|
Line 2619 sub make_new_child {
|
&logthis( |
&logthis( |
"Client $clientip ($clientname) hanging up: $userinput"); |
"Client $clientip ($clientname) hanging up: $userinput"); |
print $client "bye\n"; |
print $client "bye\n"; |
|
$client->shutdown(2); # shutdown the socket forcibly. |
$client->close(); |
$client->close(); |
last; |
last; |
|
|