--- loncom/lond 2003/09/08 10:32:07 1.141
+++ loncom/lond 2003/09/16 10:28:14 1.146
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.141 2003/09/08 10:32:07 foxr Exp $
+# $Id: lond,v 1.146 2003/09/16 10:28:14 foxr Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -60,6 +60,25 @@
# 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.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:
@@ -84,13 +103,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.141 $'; #' stupid emacs
+my $VERSION='$Revision: 1.146 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid;
my $currentdomainid;
@@ -183,6 +203,97 @@ 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>
@@ -226,19 +337,71 @@ sub PushFile {
#
my $backupfile = $tablefile;
$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 '
.$tablefile." to $backupfile</font>");
# 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:
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'}.'/';
+ if($process eq 'lonc') {
+ $processpidfile = $processpidfile."lonc.pid";
+ } elsif ($process eq 'lond') {
+ $processpidfile = $processpidfile."lond.pid";
+ } else {
+ &logthis('<font color="yellow" Invalid reinit request for '.$process
+ ."</font>");
+ return "error:Invalid process identifier $process";
+ }
+ &logthis('<font color="red"> Reinitializing '.$process." </font>");
+ return 'ok';
+}
+
#
# Convert an error return code from lcpasswd to a string value.
#
@@ -374,6 +537,19 @@ sub HUPSMAN { # sig
exec("$execdir/lond"); # here we go again
}
+#
+# 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 {
+}
+
sub checkchildren {
&initnewstatus();
&logstatus();
@@ -616,7 +792,7 @@ $SIG{CHLD} = \&REAPER;
$SIG{INT} = $SIG{TERM} = \&HUNTSMAN;
$SIG{HUP} = \&HUPSMAN;
$SIG{USR1} = \&checkchildren;
-
+$SIG{USR2} = \&UpdateHosts;
# --------------------------------------------------------------
@@ -825,7 +1001,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";
}
@@ -2043,10 +2221,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';
@@ -2066,6 +2244,12 @@ sub chatadd {
}
untie %hash;
}
+ {
+ my $hfh;
+ if ($hfh=IO::File->new(">>$proname/chatroom.log")) {
+ print $hfh "$time:".&unescape($newchat)."\n";
+ }
+ }
}
sub unsub {
@@ -2384,6 +2568,17 @@ each connection is logged.
=item *
+SIGUSR2
+
+Parent Signal assignment:
+ $SIG{USR2} = \&UpdateHosts
+
+Child signal assignment:
+ NONE
+
+
+=item *
+
SIGCHLD
Parent signal assignment: