--- loncom/lond 2003/08/12 09:39:23 1.135 +++ 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.135 2003/08/12 09:39:23 foxr 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: 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.135 $'; #' 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('Authenticating manager'. + " $hostentry"); + return 1; + } else { + &logthis(' Failed manager authentication '. + "$certificate "); + } +} +# +# 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 +# - 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(' CopyFile from '.$tablefile." to ".$backupfile." failed "); + return "error:$!"; + } + &logthis(' Pushfile: backed up ' + .$tablefile." to $backupfile"); + + # Install the new file: + + 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. # 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=) { - 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=) { + 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(); @@ -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( "INFO: Connection, $clientip ($hostid{$clientip})" @@ -652,7 +1038,7 @@ sub make_new_child { if ($userinput =~ /^ping/) { print $client "$currenthostid\n"; # ------------------------------------------------------------------------ pong - } elsif ($userinput =~ /^pong/) { + }elsif ($userinput =~ /^pong/) { my $reply=&reply("ping",$hostid{$clientip}); print $client "$currenthostid:$reply\n"; # ------------------------------------------------------------------------ ekey @@ -683,6 +1069,10 @@ sub make_new_child { } elsif ($userinput =~ /^userload/) { my $userloadpercent=&userload(); print $client "$userloadpercent\n"; + +# +# Transactions requiring encryption: +# # ----------------------------------------------------------------- currentauth } elsif ($userinput =~ /^currentauth/) { if ($wasenc==1) { @@ -697,6 +1087,33 @@ sub make_new_child { } else { print $client "refused\n"; } +#--------------------------------------------------------------------- pushfile + } elsif($userinput =~ /^pushfile/) { + 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/) { + 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) { @@ -808,10 +1225,18 @@ sub make_new_child { my $salt=time; $salt=substr($salt,6,2); my $ncpass=crypt($npass,$salt); - { my $pf = IO::File->new(">$passfilename"); - print $pf "internal:$ncpass\n"; } - &logthis("Result of password change for $uname: pwchange_success"); - print $client "ok\n"; + { + my $pf; + if ($pf = IO::File->new(">$passfilename")) { + print $pf "internal:$ncpass\n"; + &logthis("Result of password change for $uname: pwchange_success"); + print $client "ok\n"; + } else { + &logthis("Unable to open $uname passwd to change password"); + print $client "non_authorized\n"; + } + } + } else { print $client "non_authorized\n"; } @@ -990,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); @@ -1733,6 +2164,19 @@ sub make_new_child { } if ($ulsout eq '') { $ulsout='empty'; } print $client "$ulsout\n"; +# ----------------------------------------------------------------- setannounce + } elsif ($userinput =~ /^setannounce/) { + my ($cmd,$announcement)=split(/:/,$userinput); + chomp($announcement); + $announcement=&unescape($announcement); + if (my $store=IO::File->new('>'.$perlvar{'lonDocRoot'}. + '/announcement.txt')) { + print $store $announcement; + close $store; + print $client "ok\n"; + } else { + print $client "error: ".($!+0)."\n"; + } # ------------------------------------------------------------------ Hanging up } elsif (($userinput =~ /^exit/) || ($userinput =~ /^init/)) { @@ -1887,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'; @@ -1910,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 { @@ -2105,8 +2555,8 @@ sub userload { my $curtime=time; while ($filename=readdir(LONIDS)) { if ($filename eq '.' || $filename eq '..') {next;} - my ($atime)=(stat($perlvar{'lonIDsDir'}.'/'.$filename))[8]; - if ($curtime-$atime < 3600) { $numusers++; } + my ($mtime)=(stat($perlvar{'lonIDsDir'}.'/'.$filename))[9]; + if ($curtime-$mtime < 3600) { $numusers++; } } closedir(LONIDS); } @@ -2228,6 +2678,17 @@ each connection is logged. =item * +SIGUSR2 + +Parent Signal assignment: + $SIG{USR2} = \&UpdateHosts + +Child signal assignment: + NONE + + +=item * + SIGCHLD Parent signal assignment: 500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.