version 1.142, 2003/09/09 20:47:46
|
version 1.151, 2003/10/03 15:11:03
|
Line 60
|
Line 60
|
# 09/08/2003 Ron Fox: Told lond to take care of change logging so we |
# 09/08/2003 Ron Fox: Told lond to take care of change logging so we |
# don't have to remember it: |
# don't have to remember it: |
# $Log$ |
# $Log$ |
|
# Revision 1.151 2003/10/03 15:11:03 albertel |
|
# - if we fail to fetch an update to the file, don't blow away the old one |
|
# (this was the BUG that blew away that one default.sequence that Matthew |
|
# ended up restoring from data.) |
|
# |
|
# Revision 1.150 2003/09/30 10:16:06 foxr |
|
# Added invocation of apachereload in ReloadApache sub. |
|
# This completes the addtion of the reinit functionality. |
|
# |
|
# Revision 1.149 2003/09/30 09:44:13 foxr |
|
# Tested UpdateHosts ability to |
|
# - Remove live children for hosts that are no longer in the hosts.tab |
|
# - Remove live children for hosts whose IPs have changed in the hosts.tab |
|
# |
|
# Revision 1.148 2003/09/29 10:09:18 foxr |
|
# Put in logic to reinit lond itself (except for apache reload). I don't believe |
|
# this logic works correctly yet, however lond still does everything it used to doso I'll do the commit anyway. |
|
# |
|
# Revision 1.147 2003/09/23 11:23:31 foxr |
|
# Comlplete implementation of reinit functionality. Must still implement |
|
# the actual initialization functionality, but the process can now |
|
# receive the request and either invoke the appropriate internal function or |
|
# signal the correct lonc. |
|
# |
|
# Revision 1.146 2003/09/16 10:28:14 foxr |
|
# ReinitProcess - decode the process selector and produce the associated pid |
|
# filename. Note: While it is possible to test that valid process selectors are |
|
# handled properly I am not able to test that invalid process selectors produce |
|
# the appropriate error as lonManage also blocks the use of invalid process selectors. |
|
# |
|
# Revision 1.145 2003/09/16 10:13:20 foxr |
|
# Added ReinitProcess function to oversee the parsing and processing of the |
|
# reinit:<process> client request. |
|
# |
|
# Revision 1.144 2003/09/16 09:47:01 foxr |
|
# Added skeletal support for SIGUSR2 (update hosts.tab) |
|
# |
|
# Revision 1.143 2003/09/15 10:03:52 foxr |
|
# Completed and tested code for pushfile. |
|
# |
# Revision 1.142 2003/09/09 20:47:46 www |
# Revision 1.142 2003/09/09 20:47:46 www |
# Permanently store chatroom entries in chatroom.log |
# Permanently store chatroom entries in chatroom.log |
# |
# |
Line 87 use Authen::Krb4;
|
Line 127 use Authen::Krb4;
|
use Authen::Krb5; |
use Authen::Krb5; |
use lib '/home/httpd/lib/perl/'; |
use lib '/home/httpd/lib/perl/'; |
use localauth; |
use localauth; |
|
use File::Copy; |
|
|
my $DEBUG = 0; # Non zero to enable debug log entries. |
my $DEBUG = 0; # Non zero to enable debug log entries. |
|
|
Line 186 sub ValidManager {
|
Line 227 sub ValidManager {
|
} |
} |
} |
} |
# |
# |
|
# CopyFile: Called as part of the process of installing a |
|
# new configuration file. This function copies an existing |
|
# file to a backup file. |
|
# Parameters: |
|
# oldfile - Name of the file to backup. |
|
# newfile - Name of the backup file. |
|
# Return: |
|
# 0 - Failure (errno has failure reason). |
|
# 1 - Success. |
|
# |
|
sub CopyFile { |
|
my $oldfile = shift; |
|
my $newfile = shift; |
|
|
|
# The file must exist: |
|
|
|
if(-e $oldfile) { |
|
|
|
# Read the old file. |
|
|
|
my $oldfh = IO::File->new("< $oldfile"); |
|
if(!$oldfh) { |
|
return 0; |
|
} |
|
my @contents = <$oldfh>; # Suck in the entire file. |
|
|
|
# write the backup file: |
|
|
|
my $newfh = IO::File->new("> $newfile"); |
|
if(!(defined $newfh)){ |
|
return 0; |
|
} |
|
my $lines = scalar @contents; |
|
for (my $i =0; $i < $lines; $i++) { |
|
print $newfh ($contents[$i]); |
|
} |
|
|
|
$oldfh->close; |
|
$newfh->close; |
|
|
|
chmod(0660, $newfile); |
|
|
|
return 1; |
|
|
|
} else { |
|
return 0; |
|
} |
|
} |
|
|
|
# |
|
# InstallFile: Called to install an administrative file: |
|
# - The file is created with <name>.tmp |
|
# - The <name>.tmp file is then mv'd to <name> |
|
# This lugubrious procedure is done to ensure that we are never without |
|
# a valid, even if dated, version of the file regardless of who crashes |
|
# and when the crash occurs. |
|
# |
|
# Parameters: |
|
# Name of the file |
|
# File Contents. |
|
# Return: |
|
# nonzero - success. |
|
# 0 - failure and $! has an errno. |
|
# |
|
sub InstallFile { |
|
my $Filename = shift; |
|
my $Contents = shift; |
|
my $TempFile = $Filename.".tmp"; |
|
|
|
# Open the file for write: |
|
|
|
my $fh = IO::File->new("> $TempFile"); # Write to temp. |
|
if(!(defined $fh)) { |
|
&logthis('<font color="red"> Unable to create '.$TempFile."</font>"); |
|
return 0; |
|
} |
|
# write the contents of the file: |
|
|
|
print $fh ($Contents); |
|
$fh->close; # In case we ever have a filesystem w. locking |
|
|
|
chmod(0660, $TempFile); |
|
|
|
# Now we can move install the file in position. |
|
|
|
move($TempFile, $Filename); |
|
|
|
return 1; |
|
} |
|
|
|
# |
# PushFile: Called to do an administrative push of a file. |
# PushFile: Called to do an administrative push of a file. |
# - Ensure the file being pushed is one we support. |
# - Ensure the file being pushed is one we support. |
# - Backup the old file to <filename.saved> |
# - Backup the old file to <filename.saved> |
Line 229 sub PushFile {
|
Line 361 sub PushFile {
|
# |
# |
my $backupfile = $tablefile; |
my $backupfile = $tablefile; |
$backupfile =~ s/\.tab$/.old/; |
$backupfile =~ s/\.tab$/.old/; |
# CopyFile($tablefile, $backupfile); |
if(!CopyFile($tablefile, $backupfile)) { |
|
&logthis('<font color="green"> CopyFile from '.$tablefile." to ".$backupfile." failed </font>"); |
|
return "error:$!"; |
|
} |
&logthis('<font color="green"> Pushfile: backed up ' |
&logthis('<font color="green"> Pushfile: backed up ' |
.$tablefile." to $backupfile</font>"); |
.$tablefile." to $backupfile</font>"); |
|
|
# Install the new file: |
# Install the new file: |
|
|
# InstallFile($tablefile, $contents); |
if(!InstallFile($tablefile, $contents)) { |
|
&logthis('<font color="red"> Pushfile: unable to install ' |
|
.$tablefile." $! </font>"); |
|
return "error:$!"; |
|
} |
|
else { |
|
&logthis('<font color="green"> Installed new '.$tablefile |
|
."</font>"); |
|
|
|
} |
|
|
|
|
# Indicate success: |
# Indicate success: |
|
|
return "ok"; |
return "ok"; |
|
|
} |
} |
|
|
|
# |
|
# Called to re-init either lonc or lond. |
|
# |
|
# Parameters: |
|
# request - The full request by the client. This is of the form |
|
# reinit:<process> |
|
# where <process> is allowed to be either of |
|
# lonc or lond |
|
# |
|
# Returns: |
|
# The string to be sent back to the client either: |
|
# ok - Everything worked just fine. |
|
# error:why - There was a failure and why describes the reason. |
|
# |
|
# |
|
sub ReinitProcess { |
|
my $request = shift; |
|
|
|
|
|
# separate the request (reinit) from the process identifier and |
|
# validate it producing the name of the .pid file for the process. |
|
# |
|
# |
|
my ($junk, $process) = split(":", $request); |
|
my $processpidfile = $perlvar{'lonDaemons'}.'/logs/'; |
|
if($process eq 'lonc') { |
|
$processpidfile = $processpidfile."lonc.pid"; |
|
if (!open(PIDFILE, "< $processpidfile")) { |
|
return "error:Open failed for $processpidfile"; |
|
} |
|
my $loncpid = <PIDFILE>; |
|
close(PIDFILE); |
|
logthis('<font color="red"> Reinitializing lonc pid='.$loncpid |
|
."</font>"); |
|
kill("USR2", $loncpid); |
|
} elsif ($process eq 'lond') { |
|
logthis('<font color="red"> Reinitializing self (lond) </font>'); |
|
&UpdateHosts; # Lond is us!! |
|
} else { |
|
&logthis('<font color="yellow" Invalid reinit request for '.$process |
|
."</font>"); |
|
return "error:Invalid process identifier $process"; |
|
} |
|
return 'ok'; |
|
} |
|
|
# |
# |
# Convert an error return code from lcpasswd to a string value. |
# Convert an error return code from lcpasswd to a string value. |
# |
# |
Line 318 if (-e $pidfile) {
|
Line 510 if (-e $pidfile) {
|
|
|
# ------------------------------------------------------------- Read hosts file |
# ------------------------------------------------------------- Read hosts file |
|
|
open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab") || die "Can't read host file"; |
|
|
|
while (my $configline=<CONFIG>) { |
|
my ($id,$domain,$role,$name,$ip)=split(/:/,$configline); |
|
chomp($ip); $ip=~s/\D+$//; |
|
$hostid{$ip}=$id; |
|
$hostdom{$id}=$domain; |
|
$hostip{$id}=$ip; |
|
if ($id eq $perlvar{'lonHostID'}) { $thisserver=$name; } |
|
} |
|
close(CONFIG); |
|
|
|
# establish SERVER socket, bind and listen. |
# establish SERVER socket, bind and listen. |
$server = IO::Socket::INET->new(LocalPort => $perlvar{'londPort'}, |
$server = IO::Socket::INET->new(LocalPort => $perlvar{'londPort'}, |
Line 377 sub HUPSMAN { # sig
|
Line 559 sub HUPSMAN { # sig
|
exec("$execdir/lond"); # here we go again |
exec("$execdir/lond"); # here we go again |
} |
} |
|
|
|
# |
|
# Kill off hashes that describe the host table prior to re-reading it. |
|
# Hashes affected are: |
|
# %hostid, %hostdom %hostip |
|
# |
|
sub KillHostHashes { |
|
foreach my $key (keys %hostid) { |
|
delete $hostid{$key}; |
|
} |
|
foreach my $key (keys %hostdom) { |
|
delete $hostdom{$key}; |
|
} |
|
foreach my $key (keys %hostip) { |
|
delete $hostip{$key}; |
|
} |
|
} |
|
# |
|
# Read in the host table from file and distribute it into the various hashes: |
|
# |
|
# - %hostid - Indexed by IP, the loncapa hostname. |
|
# - %hostdom - Indexed by loncapa hostname, the domain. |
|
# - %hostip - Indexed by hostid, the Ip address of the host. |
|
sub ReadHostTable { |
|
|
|
open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab") || die "Can't read host file"; |
|
|
|
while (my $configline=<CONFIG>) { |
|
my ($id,$domain,$role,$name,$ip)=split(/:/,$configline); |
|
chomp($ip); $ip=~s/\D+$//; |
|
$hostid{$ip}=$id; |
|
$hostdom{$id}=$domain; |
|
$hostip{$id}=$ip; |
|
if ($id eq $perlvar{'lonHostID'}) { $thisserver=$name; } |
|
} |
|
close(CONFIG); |
|
} |
|
# |
|
# Reload the Apache daemon's state. |
|
# This is done by invoking /home/httpd/perl/apachereload |
|
# a setuid perl script that can be root for us to do this job. |
|
# |
|
sub ReloadApache { |
|
my $execdir = $perlvar{'lonDaemons'}; |
|
my $script = $execdir."/apachereload"; |
|
system($script); |
|
} |
|
|
|
# |
|
# Called in response to a USR2 signal. |
|
# - Reread hosts.tab |
|
# - All children connected to hosts that were removed from hosts.tab |
|
# are killed via SIGINT |
|
# - All children connected to previously existing hosts are sent SIGUSR1 |
|
# - Our internal hosts hash is updated to reflect the new contents of |
|
# hosts.tab causing connections from hosts added to hosts.tab to |
|
# now be honored. |
|
# |
|
sub UpdateHosts { |
|
logthis('<font color="blue"> Updating connections </font>'); |
|
# |
|
# The %children hash has the set of IP's we currently have children |
|
# on. These need to be matched against records in the hosts.tab |
|
# Any ip's no longer in the table get killed off they correspond to |
|
# either dropped or changed hosts. Note that the re-read of the table |
|
# will take care of new and changed hosts as connections come into being. |
|
|
|
|
|
KillHostHashes; |
|
ReadHostTable; |
|
|
|
foreach my $child (keys %children) { |
|
my $childip = $children{$child}; |
|
if(!$hostid{$childip}) { |
|
logthis('<font color="blue"> UpdateHosts killing child ' |
|
." $child for ip $childip </font>"); |
|
kill('INT', $child); |
|
} else { |
|
logthis('<font color="green"> keeping child for ip ' |
|
." $childip (pid=$child) </font>"); |
|
} |
|
} |
|
ReloadApache; |
|
} |
|
|
|
|
sub checkchildren { |
sub checkchildren { |
&initnewstatus(); |
&initnewstatus(); |
&logstatus(); |
&logstatus(); |
Line 619 $SIG{CHLD} = \&REAPER;
|
Line 886 $SIG{CHLD} = \&REAPER;
|
$SIG{INT} = $SIG{TERM} = \&HUNTSMAN; |
$SIG{INT} = $SIG{TERM} = \&HUNTSMAN; |
$SIG{HUP} = \&HUPSMAN; |
$SIG{HUP} = \&HUPSMAN; |
$SIG{USR1} = \&checkchildren; |
$SIG{USR1} = \&checkchildren; |
|
$SIG{USR2} = \&UpdateHosts; |
|
|
|
# Read the host hashes: |
|
|
|
ReadHostTable; |
|
|
# -------------------------------------------------------------- |
# -------------------------------------------------------------- |
# Accept connections. When a connection comes in, it is validated |
# Accept connections. When a connection comes in, it is validated |
Line 645 sub make_new_child {
|
Line 915 sub make_new_child {
|
or die "Can't block SIGINT for fork: $!\n"; |
or die "Can't block SIGINT for fork: $!\n"; |
|
|
die "fork: $!" unless defined ($pid = fork); |
die "fork: $!" unless defined ($pid = fork); |
|
|
|
$client->sockopt(SO_KEEPALIVE, 1); # Enable monitoring of |
|
# connection liveness. |
|
|
|
# |
|
# Figure out who we're talking to so we can record the peer in |
|
# the pid hash. |
|
# |
|
my $caller = getpeername($client); |
|
my ($port,$iaddr)=unpack_sockaddr_in($caller); |
|
$clientip=inet_ntoa($iaddr); |
|
|
if ($pid) { |
if ($pid) { |
# Parent records the child's birth and returns. |
# Parent records the child's birth and returns. |
sigprocmask(SIG_UNBLOCK, $sigset) |
sigprocmask(SIG_UNBLOCK, $sigset) |
or die "Can't unblock SIGINT for fork: $!\n"; |
or die "Can't unblock SIGINT for fork: $!\n"; |
$children{$pid} = 1; |
$children{$pid} = $clientip; |
$children++; |
$children++; |
&status('Started child '.$pid); |
&status('Started child '.$pid); |
return; |
return; |
Line 677 sub make_new_child {
|
Line 958 sub make_new_child {
|
# ============================================================================= |
# ============================================================================= |
# do something with the connection |
# do something with the connection |
# ----------------------------------------------------------------------------- |
# ----------------------------------------------------------------------------- |
$client->sockopt(SO_KEEPALIVE, 1);# Enable monitoring of |
# see if we know client and check for spoof IP by challenge |
# connection liveness. |
|
# see if we know client and check for spoof IP by challenge |
|
my $caller = getpeername($client); |
|
my ($port,$iaddr)=unpack_sockaddr_in($caller); |
|
$clientip=inet_ntoa($iaddr); |
|
my $clientrec=($hostid{$clientip} ne undef); |
my $clientrec=($hostid{$clientip} ne undef); |
&logthis( |
&logthis( |
"<font color=yellow>INFO: Connection, $clientip ($hostid{$clientip})</font>" |
"<font color=yellow>INFO: Connection, $clientip ($hostid{$clientip})</font>" |
Line 828 sub make_new_child {
|
Line 1105 sub make_new_child {
|
if ($wasenc == 1) { |
if ($wasenc == 1) { |
my $cert = GetCertificate($userinput); |
my $cert = GetCertificate($userinput); |
if(ValidManager($cert)) { |
if(ValidManager($cert)) { |
print $client "ok\n"; |
chomp($userinput); |
|
my $reply = ReinitProcess($userinput); |
|
print $client "$reply\n"; |
} else { |
} else { |
print $client "refused\n"; |
print $client "refused\n"; |
} |
} |
Line 1136 sub make_new_child {
|
Line 1415 sub make_new_child {
|
} |
} |
# -------------------------------------- fetch a user file from a remote server |
# -------------------------------------- fetch a user file from a remote server |
} elsif ($userinput =~ /^fetchuserfile/) { |
} elsif ($userinput =~ /^fetchuserfile/) { |
my ($cmd,$fname)=split(/:/,$userinput); |
my ($cmd,$fname)=split(/:/,$userinput); |
my ($udom,$uname,$ufile)=split(/\//,$fname); |
my ($udom,$uname,$ufile)=split(/\//,$fname); |
my $udir=propath($udom,$uname).'/userfiles'; |
my $udir=propath($udom,$uname).'/userfiles'; |
unless (-e $udir) { mkdir($udir,0770); } |
unless (-e $udir) { mkdir($udir,0770); } |
if (-e $udir) { |
if (-e $udir) { |
$ufile=~s/^[\.\~]+//; |
$ufile=~s/^[\.\~]+//; |
$ufile=~s/\///g; |
$ufile=~s/\///g; |
my $transname=$udir.'/'.$ufile; |
my $destname=$udir.'/'.$ufile; |
my $remoteurl='http://'.$clientip.'/userfiles/'.$fname; |
my $transname=$udir.'/'.$ufile.'.in.transit'; |
my $response; |
my $remoteurl='http://'.$clientip.'/userfiles/'.$fname; |
{ |
my $response; |
my $ua=new LWP::UserAgent; |
{ |
my $request=new HTTP::Request('GET',"$remoteurl"); |
my $ua=new LWP::UserAgent; |
$response=$ua->request($request,$transname); |
my $request=new HTTP::Request('GET',"$remoteurl"); |
} |
$response=$ua->request($request,$transname); |
if ($response->is_error()) { |
} |
unlink($transname); |
if ($response->is_error()) { |
my $message=$response->status_line; |
unlink($transname); |
&logthis( |
my $message=$response->status_line; |
"LWP GET: $message for $fname ($remoteurl)"); |
&logthis("LWP GET: $message for $fname ($remoteurl)"); |
print $client "failed\n"; |
print $client "failed\n"; |
} else { |
} else { |
print $client "ok\n"; |
if (!rename($transname,$destname)) { |
} |
&logthis("Unable to move $transname to $destname"); |
} else { |
unlink($transname); |
print $client "not_home\n"; |
print $client "failed\n"; |
} |
} else { |
|
print $client "ok\n"; |
|
} |
|
} |
|
} else { |
|
print $client "not_home\n"; |
|
} |
# ------------------------------------------ authenticate access to a user file |
# ------------------------------------------ authenticate access to a user file |
} elsif ($userinput =~ /^tokenauthuserfile/) { |
} elsif ($userinput =~ /^tokenauthuserfile/) { |
my ($cmd,$fname,$session)=split(/:/,$userinput); |
my ($cmd,$fname,$session)=split(/:/,$userinput); |
Line 2393 each connection is logged.
|
Line 2678 each connection is logged.
|
|
|
=item * |
=item * |
|
|
|
SIGUSR2 |
|
|
|
Parent Signal assignment: |
|
$SIG{USR2} = \&UpdateHosts |
|
|
|
Child signal assignment: |
|
NONE |
|
|
|
|
|
=item * |
|
|
SIGCHLD |
SIGCHLD |
|
|
Parent signal assignment: |
Parent signal assignment: |