--- loncom/lond 2003/08/25 15:33:47 1.139
+++ loncom/lond 2003/10/03 15:11:03 1.151
@@ -2,7 +2,7 @@
# The LearningOnline Network
# lond "LON Daemon" Server (port "LOND" 5663)
#
-# $Id: lond,v 1.139 2003/08/25 15:33:47 albertel Exp $
+# $Id: lond,v 1.151 2003/10/03 15:11:03 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -57,7 +57,59 @@
# 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.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
+# 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,24 +127,28 @@ 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.139 $'; #' stupid emacs
+my $VERSION='$Revision: 1.151 $'; #' stupid emacs
my $remoteVERSION;
my $currenthostid;
my $currentdomainid;
my $client;
+my $clientip;
+
my $server;
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."
@@ -133,6 +189,252 @@ my @adderrors = ("ok",
#
+# GetCertificate: Given a transaction that requires a certificate,
+# this function will extract the certificate from the transaction
+# request. Note that at this point, the only concept of a certificate
+# is the hostname to which we are connected.
+#
+# Parameter:
+# request - The request sent by our client (this parameterization may
+# need to change when we really use a certificate granting
+# authority.
+#
+sub GetCertificate {
+ my $request = shift;
+
+ return $clientip;
+}
+
+
+#
+# ValidManager: Determines if a given certificate represents a valid manager.
+# in this primitive implementation, the 'certificate' is
+# just the connecting loncapa client name. This is checked
+# against a valid client list in the configuration.
+#
+#
+sub ValidManager {
+ my $certificate = shift;
+
+ my $hostentry = $hostid{$certificate};
+ if ($hostentry ne undef) {
+ &logthis('<font color="yellow">Authenticating manager'.
+ " $hostentry</font>");
+ return 1;
+ } else {
+ &logthis('<font color="red"> Failed manager authentication '.
+ "$certificate </font>");
+ }
+}
+#
+# 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 {
@@ -182,7 +484,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
@@ -208,17 +510,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'},
@@ -267,6 +559,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();
@@ -509,8 +886,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
@@ -534,14 +914,24 @@ sub make_new_child {
sigprocmask(SIG_BLOCK, $sigset)
or die "Can't block SIGINT for fork: $!\n";
- my $clientip;
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;
@@ -568,12 +958,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>"
@@ -703,10 +1089,31 @@ sub make_new_child {
}
#--------------------------------------------------------------------- pushfile
} elsif($userinput =~ /^pushfile/) {
- print $client "ok\n";
+ if($wasenc == 1) {
+ my $cert = GetCertificate($userinput);
+ if(ValidManager($cert)) {
+ my $reply = PushFile($userinput);
+ print $client "$reply\n";
+ } else {
+ print $client "refused\n";
+ }
+ } else {
+ print $client "refused\n";
+ }
#--------------------------------------------------------------------- reinit
} elsif($userinput =~ /^reinit/) {
- print $client "ok\n";
+ if ($wasenc == 1) {
+ my $cert = GetCertificate($userinput);
+ if(ValidManager($cert)) {
+ chomp($userinput);
+ my $reply = ReinitProcess($userinput);
+ print $client "$reply\n";
+ } else {
+ print $client "refused\n";
+ }
+ } else {
+ print $client "refused\n";
+ }
# ------------------------------------------------------------------------ auth
} elsif ($userinput =~ /^auth/) {
if ($wasenc==1) {
@@ -1008,33 +1415,39 @@ sub make_new_child {
}
# -------------------------------------- fetch a user file from a remote server
} elsif ($userinput =~ /^fetchuserfile/) {
- my ($cmd,$fname)=split(/:/,$userinput);
- my ($udom,$uname,$ufile)=split(/\//,$fname);
- my $udir=propath($udom,$uname).'/userfiles';
- unless (-e $udir) { mkdir($udir,0770); }
+ my ($cmd,$fname)=split(/:/,$userinput);
+ my ($udom,$uname,$ufile)=split(/\//,$fname);
+ my $udir=propath($udom,$uname).'/userfiles';
+ unless (-e $udir) { mkdir($udir,0770); }
if (-e $udir) {
- $ufile=~s/^[\.\~]+//;
- $ufile=~s/\///g;
- my $transname=$udir.'/'.$ufile;
- my $remoteurl='http://'.$clientip.'/userfiles/'.$fname;
- my $response;
- {
- my $ua=new LWP::UserAgent;
- my $request=new HTTP::Request('GET',"$remoteurl");
- $response=$ua->request($request,$transname);
- }
- if ($response->is_error()) {
- unlink($transname);
- my $message=$response->status_line;
- &logthis(
- "LWP GET: $message for $fname ($remoteurl)");
- print $client "failed\n";
- } else {
- print $client "ok\n";
- }
- } else {
- print $client "not_home\n";
- }
+ $ufile=~s/^[\.\~]+//;
+ $ufile=~s/\///g;
+ my $destname=$udir.'/'.$ufile;
+ my $transname=$udir.'/'.$ufile.'.in.transit';
+ my $remoteurl='http://'.$clientip.'/userfiles/'.$fname;
+ my $response;
+ {
+ my $ua=new LWP::UserAgent;
+ my $request=new HTTP::Request('GET',"$remoteurl");
+ $response=$ua->request($request,$transname);
+ }
+ if ($response->is_error()) {
+ unlink($transname);
+ my $message=$response->status_line;
+ &logthis("LWP GET: $message for $fname ($remoteurl)");
+ print $client "failed\n";
+ } else {
+ if (!rename($transname,$destname)) {
+ &logthis("Unable to move $transname to $destname");
+ unlink($transname);
+ print $client "failed\n";
+ } else {
+ print $client "ok\n";
+ }
+ }
+ } else {
+ print $client "not_home\n";
+ }
# ------------------------------------------ authenticate access to a user file
} elsif ($userinput =~ /^tokenauthuserfile/) {
my ($cmd,$fname,$session)=split(/:/,$userinput);
@@ -1918,10 +2331,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';
@@ -1941,6 +2354,12 @@ sub chatadd {
}
untie %hash;
}
+ {
+ my $hfh;
+ if ($hfh=IO::File->new(">>$proname/chatroom.log")) {
+ print $hfh "$time:".&unescape($newchat)."\n";
+ }
+ }
}
sub unsub {
@@ -2259,6 +2678,17 @@ each connection is logged.
=item *
+SIGUSR2
+
+Parent Signal assignment:
+ $SIG{USR2} = \&UpdateHosts
+
+Child signal assignment:
+ NONE
+
+
+=item *
+
SIGCHLD
Parent signal assignment: