--- loncom/lond 2003/09/16 09:47:01 1.144 +++ loncom/lond 2003/10/13 08:49:54 1.156 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.144 2003/09/16 09:47:01 foxr Exp $ +# $Id: lond,v 1.156 2003/10/13 08:49:54 foxr Exp $ # # Copyright Michigan State University Board of Trustees # @@ -59,21 +59,6 @@ # - 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.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) # @@ -100,7 +85,7 @@ my $DEBUG = 0; # Non zero to ena my $status=''; my $lastlog=''; -my $VERSION='$Revision: 1.144 $'; #' stupid emacs +my $VERSION='$Revision: 1.156 $'; #' stupid emacs my $remoteVERSION; my $currenthostid; my $currentdomainid; @@ -114,6 +99,7 @@ my $thisserver; my %hostid; my %hostdom; my %hostip; +my %managers; # If defined $managers{hostname} is a manager my %perlvar; # Will have the apache conf defined perl vars. # @@ -144,10 +130,10 @@ my @adderrors = ("ok", "lcuseradd Incorrect number of stdinput lines, must be 3", "lcuseradd Too many other simultaneous pwd changes in progress", "lcuseradd User does not exist", - "lcuseradd Unabel to mak ewww member of users's group", + "lcuseradd Unable to make www member of users's group", "lcuseradd Unable to su to root", "lcuseradd Unable to set password", - "lcuseradd Usrname has invbalid charcters", + "lcuseradd Usrname has invalid characters", "lcuseradd Password has an invalid character", "lcuseradd User already exists", "lcuseradd Could not add user.", @@ -170,7 +156,37 @@ sub GetCertificate { return $clientip; } +# +# ReadManagerTable: Reads in the current manager table. For now this is +# done on each manager authentication because: +# - These authentications are not frequent +# - This allows dynamic changes to the manager table +# without the need to signal to the lond. +# + +sub ReadManagerTable { + + # Clean out the old table first.. + + foreach my $key (keys %managers) { + delete $managers{$key}; + } + my $tablename = $perlvar{'lonTabDir'}."/managers.tab"; + if (!open (MANAGERS, $tablename)) { + logthis('No manager table. Nobody can manage!!'); + return; + } + while(my $host = ) { + chomp($host); + if (!defined $hostip{$host}) { + logthis(' manager '.$host. + " not in hosts.tab, rejected as manager"); + } else { + $managers{$host} = $hostip{$host}; # Whatever for now. + } + } +} # # ValidManager: Determines if a given certificate represents a valid manager. @@ -182,14 +198,25 @@ sub GetCertificate { sub ValidManager { my $certificate = shift; - my $hostentry = $hostid{$certificate}; - if ($hostentry ne undef) { - &logthis('Authenticating manager'. - " $hostentry"); - return 1; + ReadManagerTable; + + my $hostname = $hostid{$certificate}; + + + if ($hostname ne undef) { + if($managers{$hostname} ne undef) { + &logthis('Authenticating manager'. + " $hostname"); + return 1; + } else { + &logthis('"); + return 0; + } } else { &logthis(' Failed manager authentication '. "$certificate "); + return 0; } } # @@ -338,7 +365,7 @@ sub PushFile { if(!InstallFile($tablefile, $contents)) { &logthis(' Pushfile: unable to install ' - .$tablefile." $! "); + .$tablefile." $! "); return "error:$!"; } else { @@ -353,6 +380,53 @@ sub PushFile { 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. # @@ -429,17 +503,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'}, @@ -489,6 +553,53 @@ sub HUPSMAN { # sig } # +# 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 @@ -499,8 +610,33 @@ sub HUPSMAN { # sig # 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(); @@ -532,7 +668,7 @@ sub checkchildren { } } $SIG{ALRM} = 'DEFAULT'; - $SIG{__DIE__} = \&cathcexception; + $SIG{__DIE__} = \&catchexception; } # --------------------------------------------------------------------- Logging @@ -745,6 +881,9 @@ $SIG{HUP} = \&HUPSMAN; $SIG{USR1} = \&checkchildren; $SIG{USR2} = \&UpdateHosts; +# Read the host hashes: + +ReadHostTable; # -------------------------------------------------------------- # Accept connections. When a connection comes in, it is validated @@ -769,12 +908,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; @@ -801,12 +951,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})" @@ -952,7 +1098,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"; } @@ -1260,33 +1408,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);