--- loncom/lond 2003/12/22 11:29:58 1.167 +++ loncom/lond 2004/03/08 20:59:41 1.180 @@ -2,7 +2,7 @@ # The LearningOnline Network # lond "LON Daemon" Server (port "LOND" 5663) # -# $Id: lond,v 1.167 2003/12/22 11:29:58 foxr Exp $ +# $Id: lond,v 1.180 2004/03/08 20:59:41 albertel Exp $ # # Copyright Michigan State University Board of Trustees # @@ -46,13 +46,14 @@ use Authen::Krb5; use lib '/home/httpd/lib/perl/'; use localauth; use File::Copy; +use LONCAPA::ConfigFileEdit; my $DEBUG = 0; # Non zero to enable debug log entries. my $status=''; my $lastlog=''; -my $VERSION='$Revision: 1.167 $'; #' stupid emacs +my $VERSION='$Revision: 1.180 $'; #' stupid emacs my $remoteVERSION; my $currenthostid; my $currentdomainid; @@ -349,7 +350,31 @@ sub InstallFile { return 1; } +# +# ConfigFileFromSelector: converts a configuration file selector +# (one of host or domain at this point) into a +# configuration file pathname. +# +# Parameters: +# selector - Configuration file selector. +# Returns: +# Full path to the file or undef if the selector is invalid. +# +sub ConfigFileFromSelector { + my $selector = shift; + my $tablefile; + + my $tabledir = $perlvar{'lonTabDir'}.'/'; + if ($selector eq "hosts") { + $tablefile = $tabledir."hosts.tab"; + } elsif ($selector eq "domain") { + $tablefile = $tabledir."domain.tab"; + } else { + return undef; + } + return $tablefile; +} # # PushFile: Called to do an administrative push of a file. # - Ensure the file being pushed is one we support. @@ -379,12 +404,9 @@ sub PushFile { # 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 { + + my $tablefile = ConfigFileFromSelector($filename); + if(! (defined $tablefile)) { return "refused"; } # @@ -476,18 +498,180 @@ sub ReinitProcess { } return 'ok'; } +# Validate a line in a configuration file edit script: +# Validation includes: +# - Ensuring the command is valid. +# - Ensuring the command has sufficient parameters +# Parameters: +# scriptline - A line to validate (\n has been stripped for what it's worth). +# +# Return: +# 0 - Invalid scriptline. +# 1 - Valid scriptline +# NOTE: +# Only the command syntax is checked, not the executability of the +# command. +# +sub isValidEditCommand { + my $scriptline = shift; + + # Line elements are pipe separated: + + my ($command, $key, $newline) = split(/\|/, $scriptline); + &logthis(' isValideditCommand checking: '. + "Command = '$command', Key = '$key', Newline = '$newline' \n"); + + if ($command eq "delete") { + # + # key with no newline. + # + if( ($key eq "") || ($newline ne "")) { + return 0; # Must have key but no newline. + } else { + return 1; # Valid syntax. + } + } elsif ($command eq "replace") { + # + # key and newline: + # + if (($key eq "") || ($newline eq "")) { + return 0; + } else { + return 1; + } + } elsif ($command eq "append") { + if (($key ne "") && ($newline eq "")) { + return 1; + } else { + return 0; + } + } else { + return 0; # Invalid command. + } + return 0; # Should not get here!!! +} +# +# ApplyEdit - Applies an edit command to a line in a configuration +# file. It is the caller's responsiblity to validate the +# edit line. +# Parameters: +# $directive - A single edit directive to apply. +# Edit directives are of the form: +# append|newline - Appends a new line to the file. +# replace|key|newline - Replaces the line with key value 'key' +# delete|key - Deletes the line with key value 'key'. +# $editor - A config file editor object that contains the +# file being edited. +# +sub ApplyEdit { + my $directive = shift; + my $editor = shift; + + # Break the directive down into its command and its parameters + # (at most two at this point. The meaning of the parameters, if in fact + # they exist depends on the command). + + my ($command, $p1, $p2) = split(/\|/, $directive); + + if($command eq "append") { + $editor->Append($p1); # p1 - key p2 null. + } elsif ($command eq "replace") { + $editor->ReplaceLine($p1, $p2); # p1 - key p2 = newline. + } elsif ($command eq "delete") { + $editor->DeleteLine($p1); # p1 - key p2 null. + } else { # Should not get here!!! + die "Invalid command given to ApplyEdit $command" + } +} +# +# AdjustOurHost: +# Adjusts a host file stored in a configuration file editor object +# for the true IP address of this host. This is necessary for hosts +# that live behind a firewall. +# Those hosts have a publicly distributed IP of the firewall, but +# internally must use their actual IP. We assume that a given +# host only has a single IP interface for now. +# Formal Parameters: +# editor - The configuration file editor to adjust. This +# editor is assumed to contain a hosts.tab file. +# Strategy: +# - Figure out our hostname. +# - Lookup the entry for this host. +# - Modify the line to contain our IP +# - Do a replace for this host. +sub AdjustOurHost { + my $editor = shift; + + # figure out who I am. + + my $myHostName = $perlvar{'lonHostID'}; # LonCAPA hostname. + + # Get my host file entry. + + my $ConfigLine = $editor->Find($myHostName); + if(! (defined $ConfigLine)) { + die "AdjustOurHost - no entry for me in hosts file $myHostName"; + } + # figure out my IP: + # Use the config line to get my hostname. + # Use gethostbyname to translate that into an IP address. + # + my ($id,$domain,$role,$name,$ip,$maxcon,$idleto,$mincon) = split(/:/,$ConfigLine); + my $BinaryIp = gethostbyname($name); + my $ip = inet_ntoa($ip); + # + # Reassemble the config line from the elements in the list. + # Note that if the loncnew items were not present before, they will + # be now even if they would be empty + # + my $newConfigLine = $id; + foreach my $item ($domain, $role, $name, $ip, $maxcon, $idleto, $mincon) { + $newConfigLine .= ":".$item; + } + # Replace the line: + + $editor->ReplaceLine($id, $newConfigLine); + +} # -# Called to edit a file +# ReplaceConfigFile: +# Replaces a configuration file with the contents of a +# configuration file editor object. +# This is done by: +# - Copying the target file to .old +# - Writing the new file to .tmp +# - Moving -> +# This laborious process ensures that the system is never without +# a configuration file that's at least valid (even if the contents +# may be dated). +# Parameters: +# filename - Name of the file to modify... this is a full path. +# editor - Editor containing the file. +# +sub ReplaceConfigFile { + my $filename = shift; + my $editor = shift; + + CopyFile ($filename, $filename.".old"); + + my $contents = $editor->Get(); # Get the contents of the file. + + InstallFile($filename, $contents); +} +# +# +# Called to edit a configuration table file # Parameters: # request - The entire command/request sent by lonc or lonManage # Return: # The reply to send to the client. +# sub EditFile { my $request = shift; # Split the command into it's pieces: edit:filetype:script - my ($request, $filetype, $script) = split(":", $request); + my ($request, $filetype, $script) = split(/:/, $request,3); # : in script # Check the pre-coditions for success: @@ -501,8 +685,37 @@ sub EditFile { # Split the edit script and check it's validity. + my @scriptlines = split(/\n/, $script); # one line per element. + my $linecount = scalar(@scriptlines); + for(my $i = 0; $i < $linecount; $i++) { + chomp($scriptlines[$i]); + if(!isValidEditCommand($scriptlines[$i])) { + return "error:edit with bad script line: '$scriptlines[$i]' \n"; + } + } + # Execute the edit operation. + # - Create a config file editor for the appropriate file and + # - execute each command in the script: + # + my $configfile = ConfigFileFromSelector($filetype); + if (!(defined $configfile)) { + return "refused\n"; + } + my $editor = ConfigFileEdit->new($configfile); + for (my $i = 0; $i < $linecount; $i++) { + ApplyEdit($scriptlines[$i], $editor); + } + # If the file is the host file, ensure that our host is + # adjusted to have our ip: + # + if($filetype eq "host") { + AdjustOurHost($editor); + } + # Finally replace the current file with our file. + # + ReplaceConfigFile($configfile, $editor); return "ok\n"; } @@ -599,18 +812,26 @@ $server = IO::Socket::INET->new(LocalPor # global variables my %children = (); # keys are current child process IDs -my $children = 0; # current number of children sub REAPER { # takes care of dead children $SIG{CHLD} = \&REAPER; &status("Handling child death"); - my $pid = wait; - if (defined($children{$pid})) { - &logthis("Child $pid died"); - $children --; - delete $children{$pid}; - } else { - &logthis("Unknown Child $pid died"); + my $pid; + do { + $pid = waitpid(-1,&WNOHANG()); + if (defined($children{$pid})) { + &logthis("Child $pid died"); + delete($children{$pid}); + } else { + &logthis("Unknown Child $pid died"); + } + } while ( $pid > 0 ); + foreach my $child (keys(%children)) { + $pid = waitpid($child,&WNOHANG()); + if ($pid > 0) { + &logthis("Child $child - $pid looks like we missed it's death"); + delete($children{$pid}); + } } &status("Finished Handling child death"); } @@ -666,12 +887,14 @@ 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; } + if (!($configline =~ /^\s*\#/)) { + 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); } @@ -807,7 +1030,7 @@ sub logstatus { my $docdir=$perlvar{'lonDocRoot'}; { my $fh=IO::File->new(">>$docdir/lon-status/londstatus.txt"); - print $fh $$."\t".$currenthostid."\t".$status."\t".$lastlog."\n"; + print $fh $$."\t".$clientname."\t".$currenthostid."\t".$status."\t".$lastlog."\n"; $fh->close(); } &status("Finished londstatus.txt"); @@ -1035,15 +1258,24 @@ sub make_new_child { # the pid hash. # my $caller = getpeername($client); - my ($port,$iaddr)=unpack_sockaddr_in($caller); - $clientip=inet_ntoa($iaddr); + my ($port,$iaddr); + if (defined($caller) && length($caller) > 0) { + ($port,$iaddr)=unpack_sockaddr_in($caller); + } else { + &logthis("Unable to determine who caller was, getpeername returned nothing"); + } + if (defined($iaddr)) { + $clientip=inet_ntoa($iaddr); + } else { + &logthis("Unable to determine clinetip"); + $clientip='Unavailable'; + } 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} = $clientip; - $children++; &status('Started child '.$pid); return; } else { @@ -1480,7 +1712,7 @@ sub make_new_child { unless (mkdir($fpnow,0777)) { $fperror="error: ".($!+0) ." mkdir failed while attempting " - ."makeuser\n"; + ."makeuser"; } } } @@ -2115,7 +2347,6 @@ sub make_new_child { my $proname=propath($udom,$uname); my %hash; if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER(),0640)) { - study($regexp); while (my ($key,$value) = each(%hash)) { if ($regexp eq '.') { $qresult.=$key.'='.$value.'&'; @@ -2511,6 +2742,8 @@ sub make_new_child { # -------------------------------------------------------------------------- ls } elsif ($userinput =~ /^ls/) { if(isClient) { + my $obs; + my $rights; my ($cmd,$ulsdir)=split(/:/,$userinput); my $ulsout=''; my $ulsfn; @@ -2518,9 +2751,22 @@ sub make_new_child { if(-d $ulsdir) { if (opendir(LSDIR,$ulsdir)) { while ($ulsfn=readdir(LSDIR)) { + undef $obs, $rights; my @ulsstats=stat($ulsdir.'/'.$ulsfn); - $ulsout.=$ulsfn.'&'. - join('&',@ulsstats).':'; + #We do some obsolete checking here + if(-e $ulsdir.'/'.$ulsfn.".meta") { + open(FILE, $ulsdir.'/'.$ulsfn.".meta"); + my @obsolete=; + foreach my $obsolete (@obsolete) { + if($obsolete =~ m|()(on)|) { $obs = 1; } + if($obsolete =~ m|()(default)|) { $rights = 1; } + } + } + $ulsout.=$ulsfn.'&'.join('&',@ulsstats); + if($obs eq '1') { $ulsout.="&1"; } + else { $ulsout.="&0"; } + if($rights eq '1') { $ulsout.="&1:"; } + else { $ulsout.="&0:"; } } closedir(LSDIR); } @@ -2631,7 +2877,6 @@ sub ManagePermissions my $authtype= shift; # See if the request is of the form /$domain/_au - &logthis("ruequest is $request"); if($request =~ /^(\/$domain\/_au)$/) { # It's an author rolesput... my $execdir = $perlvar{'lonDaemons'}; my $userhome= "/home/$user" ;