--- loncom/lond	2003/12/22 11:03:37	1.166
+++ loncom/lond	2004/03/09 21:05:13	1.183
@@ -2,7 +2,7 @@
 # The LearningOnline Network
 # lond "LON Daemon" Server (port "LOND" 5663)
 #
-# $Id: lond,v 1.166 2003/12/22 11:03:37 foxr Exp $
+# $Id: lond,v 1.183 2004/03/09 21:05:13 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -10,7 +10,7 @@
 #
 # LON-CAPA is free software; you can redistribute it and/or modify
 # it under the terms of the GNU General Public License as published by
-# the Free Software Foundation; either version 2 of the License, or
+# the Free Software Foundation; either version 2 of the License, or 
 # (at your option) any later version.
 #
 # LON-CAPA is distributed in the hope that it will be useful,
@@ -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.166 $'; #' stupid emacs
+my $VERSION='$Revision: 1.183 $'; #' 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,7 +498,227 @@ 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('<font color="green"> isValideditCommand checking: '.
+	     "Command = '$command', Key = '$key', Newline = '$newline' </font>\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);
+    
+}
+#
+#   ReplaceConfigFile:
+#              Replaces a configuration file with the contents of a
+#              configuration file editor object.
+#              This is done by:
+#              - Copying the target file to <filename>.old
+#              - Writing the new file to <filename>.tmp
+#              - Moving <filename.tmp>  -> <filename>
+#              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,3);	# : in script
+
+    #  Check the pre-coditions for success:
+
+    if($request != "edit") {	# Something is amiss afoot alack.
+	return "error:edit request detected, but request != 'edit'\n";
+    }
+    if( ($filetype ne "hosts")  &&
+	($filetype ne "domain")) {
+	return "error:edit requested with invalid file specifier: $filetype \n";
+    }
+
+    #   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";
+}
 #
 #  Convert an error return code from lcpasswd to a string value.
 #
@@ -570,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});
+	} elsif ($pid > 0) {
+	    &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");
 }
@@ -637,12 +887,14 @@ 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; }
+	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);
 }
@@ -778,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");
@@ -1006,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 {
@@ -1237,7 +1498,7 @@ sub make_new_child {
                my($command, $filetype, $script) = split(/:/, $userinput);
                if (($filetype eq "hosts") || ($filetype eq "domain")) {
                   if($script ne "") {
-                     Reply($client,"ok\n",$userinput);       # DEBUG: Call EditFile here.
+		      Reply($client, EditFile($userinput));
                   } else {
                      Reply($client,"refused\n",$userinput);
                   }
@@ -1451,7 +1712,7 @@ sub make_new_child {
 				    unless (mkdir($fpnow,0777)) {
 					$fperror="error: ".($!+0)
 					    ." mkdir failed while attempting "
-					    ."makeuser\n";
+					    ."makeuser";
 				    }
 				}
 			    }
@@ -1566,16 +1827,27 @@ sub make_new_child {
 # -------------------------------------- fetch a user file from a remote server
 		} elsif ($userinput =~ /^fetchuserfile/) { # Client clear or enc.
 		    if(isClient) {
-			my ($cmd,$fname)=split(/:/,$userinput);
+			my ($cmd,$fname,$fpath)=split(/:/,$userinput);
 			my ($udom,$uname,$ufile)=split(/\//,$fname);
 			my $udir=propath($udom,$uname).'/userfiles';
 			unless (-e $udir) { mkdir($udir,0770); }
 			if (-e $udir) {
+                            unless ($fpath eq '') {
+                                my $filepath = $udir;
+                                my @parts=split(/\//,$fpath);
+                                my $count;
+                                for ($count=0;$count<=$#parts;$count++) {
+                                    $filepath .="/$parts[$count]";
+                                    if ((-e $filepath)!=1) {
+                                        mkdir($filepath,0770);
+                                    }
+                                }
+                            }
 			    $ufile=~s/^[\.\~]+//;
 			    $ufile=~s/\///g;
-			    my $destname=$udir.'/'.$ufile;
-			    my $transname=$udir.'/'.$ufile.'.in.transit';
-			    my $remoteurl='http://'.$clientip.'/userfiles/'.$fname;
+			    my $destname=$udir.'/'.$fpath.$ufile;
+			    my $transname=$udir.'/'.$fpath.$ufile.'.in.transit';
+			    my $remoteurl='http://'.$clientip.'/userfiles/'.$udom.'/'.$uname.'/'.$fpath.$ufile;
 			    my $response;
 			    {
 				my $ua=new LWP::UserAgent;
@@ -1585,7 +1857,7 @@ sub make_new_child {
 			    if ($response->is_error()) {
 				unlink($transname);
 				my $message=$response->status_line;
-				&logthis("LWP GET: $message for $fname ($remoteurl)");
+				&logthis("LWP GET: $message for $fpath $fname ($remoteurl)");
 				print $client "failed\n";
 			    } else {
 				if (!rename($transname,$destname)) {
@@ -1755,12 +2027,12 @@ sub make_new_child {
 				} else {
 				    print $client "error: ".($!+0)
 					." untie(GDBM) failed ".
-					"while attempting put\n";
+					"while attempting inc\n";
 				}
 			    } else {
 				print $client "error: ".($!)
 				    ." tie(GDBM) Failed ".
-				    "while attempting put\n";
+				    "while attempting inc\n";
 			    }
 			} else {
 			    print $client "refused\n";
@@ -2086,7 +2358,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.'&';
@@ -2482,6 +2753,8 @@ sub make_new_child {
 # -------------------------------------------------------------------------- ls
 		} elsif ($userinput =~ /^ls/) {
 		    if(isClient) {
+			my $obs;
+			my $rights;
 			my ($cmd,$ulsdir)=split(/:/,$userinput);
 			my $ulsout='';
 			my $ulsfn;
@@ -2489,9 +2762,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=<FILE>;
+					    foreach my $obsolete (@obsolete) {
+					        if($obsolete =~ m|(<obsolete>)(on)|) { $obs = 1; } 
+						if($obsolete =~ m|(<copyright>)(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);
 				}
@@ -2602,7 +2888,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" ;