--- loncom/lond 2003/08/26 11:15:57 1.140
+++ loncom/lond 2003/09/30 10:16:06 1.150
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.140 2003/08/26 11:15:57 foxr Exp $
+# $Id: lond,v 1.150 2003/09/30 10:16:06 foxr Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -57,7 +57,54 @@
# Management functions supported include:
# - pushing /home/httpd/lonTabs/hosts.tab
# - pushing /home/httpd/lonTabs/domain.tab
-###
+# 09/08/2003 Ron Fox: Told lond to take care of change logging so we
+# don't have to remember it:
+# $Log: lond,v $
+# 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
+# Permanently store chatroom entries in chatroom.log
+#
+# Revision 1.141 2003/09/08 10:32:07 foxr
+# Added PushFile sub This sub oversees the push of a new configuration table file
+# Currently supported files are:
+# - hosts.tab (transaction pushfile:hosts:contents)
+# - domain.tab (transaction pushfile:domain:contents)
+#
+
use strict;
use lib '/home/httpd/lib/perl/';
@@ -75,13 +122,14 @@ use Authen::Krb4;
use Authen::Krb5;
use lib '/home/httpd/lib/perl/';
use localauth;
+use File::Copy;
my $DEBUG = 0; # Non zero to enable debug log entries.
my $status='';
my $lastlog='';
-my $VERSION='$Revision: 1.140 $'; #' stupid emacs
+my $VERSION='$Revision: 1.150 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid;
my $currentdomainid;
@@ -95,6 +143,7 @@ my $thisserver;
my %hostid;
my %hostdom;
my %hostip;
+my %perlvar; # Will have the apache conf defined perl vars.
#
# The array below are password error strings."
@@ -173,6 +222,214 @@ 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.
+# - Ensure the file being pushed is one we support.
+# - Backup the old file to <filename.saved>
+# - Separate the contents of the new file out from the
+# rest of the request.
+# - Write the new file.
+# Parameter:
+# Request - The entire user request. This consists of a : separated
+# string pushfile:tablename:contents.
+# NOTE: The contents may have :'s in it as well making things a bit
+# more interesting... but not much.
+# Returns:
+# String to send to client ("ok" or "refused" if bad file).
+#
+sub PushFile {
+ my $request = shift;
+ my ($command, $filename, $contents) = split(":", $request, 3);
+
+ # At this point in time, pushes for only the following tables are
+ # supported:
+ # hosts.tab ($filename eq host).
+ # domain.tab ($filename eq domain).
+ # Construct the destination filename or reject the request.
+ #
+ # lonManage is supposed to ensure this, however this session could be
+ # part of some elaborate spoof that managed somehow to authenticate.
+ #
+
+ my $tablefile = $perlvar{'lonTabDir'}.'/'; # need to precede with dir.
+ if ($filename eq "host") {
+ $tablefile .= "hosts.tab";
+ } elsif ($filename eq "domain") {
+ $tablefile .= "domain.tab";
+ } else {
+ return "refused";
+ }
+ #
+ # >copy< the old table to the backup table
+ # don't rename in case system crashes/reboots etc. in the time
+ # window between a rename and write.
+ #
+ my $backupfile = $tablefile;
+ $backupfile =~ s/\.tab$/.old/;
+ if(!CopyFile($tablefile, $backupfile)) {
+ &logthis('<font color="green"> CopyFile from '.$tablefile." to ".$backupfile." failed </font>");
+ return "error:$!";
+ }
+ &logthis('<font color="green"> Pushfile: backed up '
+ .$tablefile." to $backupfile</font>");
+
+ # Install the new file:
+
+ 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:
+
+ 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.
#
sub lcpasswdstrerror {
@@ -222,7 +479,7 @@ $SIG{__DIE__}=\&catchexception;
# ---------------------------------- Read loncapa_apache.conf and loncapa.conf
&status("Read loncapa.conf and loncapa_apache.conf");
my $perlvarref=LONCAPA::Configuration::read_conf('loncapa.conf');
-my %perlvar=%{$perlvarref};
+%perlvar=%{$perlvarref};
undef $perlvarref;
# ----------------------------- Make sure this process is running from user=www
@@ -248,17 +505,7 @@ if (-e $pidfile) {
# ------------------------------------------------------------- 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.
$server = IO::Socket::INET->new(LocalPort => $perlvar{'londPort'},
@@ -307,6 +554,91 @@ sub HUPSMAN { # sig
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 {
&initnewstatus();
&logstatus();
@@ -549,8 +881,11 @@ $SIG{CHLD} = \&REAPER;
$SIG{INT} = $SIG{TERM} = \&HUNTSMAN;
$SIG{HUP} = \&HUPSMAN;
$SIG{USR1} = \&checkchildren;
+$SIG{USR2} = \&UpdateHosts;
+# Read the host hashes:
+ReadHostTable;
# --------------------------------------------------------------
# Accept connections. When a connection comes in, it is validated
@@ -575,12 +910,23 @@ sub make_new_child {
or die "Can't block SIGINT for fork: $!\n";
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) {
# Parent records the child's birth and returns.
sigprocmask(SIG_UNBLOCK, $sigset)
or die "Can't unblock SIGINT for fork: $!\n";
- $children{$pid} = 1;
+ $children{$pid} = $clientip;
$children++;
&status('Started child '.$pid);
return;
@@ -607,12 +953,8 @@ sub make_new_child {
# =============================================================================
# do something with the connection
# -----------------------------------------------------------------------------
- $client->sockopt(SO_KEEPALIVE, 1);# Enable monitoring of
- # 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);
+ # see if we know client and check for spoof IP by challenge
+
my $clientrec=($hostid{$clientip} ne undef);
&logthis(
"<font color=yellow>INFO: Connection, $clientip ($hostid{$clientip})</font>"
@@ -745,7 +1087,8 @@ sub make_new_child {
if($wasenc == 1) {
my $cert = GetCertificate($userinput);
if(ValidManager($cert)) {
- print $client "ok\n";
+ my $reply = PushFile($userinput);
+ print $client "$reply\n";
} else {
print $client "refused\n";
}
@@ -757,7 +1100,9 @@ sub make_new_child {
if ($wasenc == 1) {
my $cert = GetCertificate($userinput);
if(ValidManager($cert)) {
- print $client "ok\n";
+ chomp($userinput);
+ my $reply = ReinitProcess($userinput);
+ print $client "$reply\n";
} else {
print $client "refused\n";
}
@@ -1975,10 +2320,10 @@ sub chatadd {
my %hash;
my $proname=&propath($cdom,$cname);
my @entries=();
+ my $time=time;
if (tie(%hash,'GDBM_File',"$proname/nohist_chatroom.db",
&GDBM_WRCREAT(),0640)) {
@entries=map { $_.':'.$hash{$_} } sort keys %hash;
- my $time=time;
my ($lastid)=($entries[$#entries]=~/^(\w+)\:/);
my ($thentime,$idnum)=split(/\_/,$lastid);
my $newid=$time.'_000000';
@@ -1998,6 +2343,12 @@ sub chatadd {
}
untie %hash;
}
+ {
+ my $hfh;
+ if ($hfh=IO::File->new(">>$proname/chatroom.log")) {
+ print $hfh "$time:".&unescape($newchat)."\n";
+ }
+ }
}
sub unsub {
@@ -2316,6 +2667,17 @@ each connection is logged.
=item *
+SIGUSR2
+
+Parent Signal assignment:
+ $SIG{USR2} = \&UpdateHosts
+
+Child signal assignment:
+ NONE
+
+
+=item *
+
SIGCHLD
Parent signal assignment: