--- loncom/lond 2003/09/08 10:32:07 1.141 +++ loncom/lond 2003/10/08 14:18:34 1.152 @@ -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.152 2003/10/08 14:18:34 www Exp $ # # Copyright Michigan State University Board of Trustees # @@ -60,6 +60,52 @@ # 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.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 +# 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: 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 +130,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.152 $'; #' stupid emacs my $remoteVERSION; my $currenthostid; my $currentdomainid; @@ -183,6 +230,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 .tmp +# - The .tmp file is then mv'd to +# 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(' Unable to create '.$TempFile.""); + 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 @@ -226,19 +364,79 @@ sub PushFile { # my $backupfile = $tablefile; $backupfile =~ s/\.tab$/.old/; - # CopyFile($tablefile, $backupfile); + if(!CopyFile($tablefile, $backupfile)) { + &logthis(' CopyFile from '.$tablefile." to ".$backupfile." failed "); + return "error:$!"; + } &logthis(' Pushfile: backed up ' .$tablefile." to $backupfile"); # Install the new file: - # InstallFile($tablefile, $contents); + if(!InstallFile($tablefile, $contents)) { + &logthis(' Pushfile: unable to install ' + .$tablefile." $! "); + return "error:$!"; + } + else { + &logthis(' Installed new '.$tablefile + .""); + + } + # 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: +# where 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 = ; + close(PIDFILE); + logthis(' Reinitializing lonc pid='.$loncpid + .""); + kill("USR2", $loncpid); + } elsif ($process eq 'lond') { + logthis(' Reinitializing self (lond) '); + &UpdateHosts; # Lond is us!! + } else { + &logthis('"); + return "error:Invalid process identifier $process"; + } + return 'ok'; +} + # # Convert an error return code from lcpasswd to a string value. # @@ -315,17 +513,7 @@ if (-e $pidfile) { # ------------------------------------------------------------- Read hosts file -open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab") || die "Can't read host file"; -while (my $configline=) { - 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'}, @@ -374,6 +562,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=) { + 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(' Updating connections '); + # + # 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(' UpdateHosts killing child ' + ." $child for ip $childip "); + kill('INT', $child); + } else { + logthis(' keeping child for ip ' + ." $childip (pid=$child) "); + } + } + ReloadApache; +} + + sub checkchildren { &initnewstatus(); &logstatus(); @@ -405,7 +678,7 @@ sub checkchildren { } } $SIG{ALRM} = 'DEFAULT'; - $SIG{__DIE__} = \&cathcexception; + $SIG{__DIE__} = \&catchcexception; } # --------------------------------------------------------------------- Logging @@ -616,8 +889,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 @@ -642,12 +918,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; @@ -674,12 +961,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( "INFO: Connection, $clientip ($hostid{$clientip})" @@ -825,7 +1108,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"; } @@ -1133,33 +1418,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); @@ -2043,10 +2334,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 +2357,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 +2681,17 @@ each connection is logged. =item * +SIGUSR2 + +Parent Signal assignment: + $SIG{USR2} = \&UpdateHosts + +Child signal assignment: + NONE + + +=item * + SIGCHLD Parent signal assignment: