version 1.147, 2003/09/23 11:23:31
|
version 1.152, 2003/10/08 14:18:34
|
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.152 2003/10/08 14:18:34 www |
|
# Not good: this should be backported into 1.0.2! |
|
# |
|
# 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 |
# Revision 1.147 2003/09/23 11:23:31 foxr |
# Comlplete implementation of reinit functionality. Must still implement |
# Comlplete implementation of reinit functionality. Must still implement |
# the actual initialization functionality, but the process can now |
# the actual initialization functionality, but the process can now |
Line 492 if (-e $pidfile) {
|
Line 513 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 552 sub HUPSMAN { # sig
|
Line 563 sub HUPSMAN { # sig
|
} |
} |
|
|
# |
# |
|
# 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. |
# Called in response to a USR2 signal. |
# - Reread hosts.tab |
# - Reread hosts.tab |
# - All children connected to hosts that were removed from hosts.tab |
# - All children connected to hosts that were removed from hosts.tab |
Line 563 sub HUPSMAN { # sig
|
Line 621 sub HUPSMAN { # sig
|
# |
# |
sub UpdateHosts { |
sub UpdateHosts { |
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 |
|
# 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 596 sub checkchildren {
|
Line 678 sub checkchildren {
|
} |
} |
} |
} |
$SIG{ALRM} = 'DEFAULT'; |
$SIG{ALRM} = 'DEFAULT'; |
$SIG{__DIE__} = \&cathcexception; |
$SIG{__DIE__} = \&catchcexception; |
} |
} |
|
|
# --------------------------------------------------------------------- Logging |
# --------------------------------------------------------------------- Logging |
Line 809 $SIG{HUP} = \&HUPSMAN;
|
Line 891 $SIG{HUP} = \&HUPSMAN;
|
$SIG{USR1} = \&checkchildren; |
$SIG{USR1} = \&checkchildren; |
$SIG{USR2} = \&UpdateHosts; |
$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 833 sub make_new_child {
|
Line 918 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 865 sub make_new_child {
|
Line 961 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 1326 sub make_new_child {
|
Line 1418 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); |