--- loncom/lond	2003/03/27 23:00:28	1.121
+++ loncom/lond	2003/08/12 19:46:04	1.136
@@ -2,7 +2,7 @@
 # The LearningOnline Network
 # lond "LON Daemon" Server (port "LOND" 5663)
 #
-# $Id: lond,v 1.121 2003/03/27 23:00:28 albertel Exp $
+# $Id: lond,v 1.136 2003/08/12 19:46:04 www Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -50,14 +50,22 @@
 #      population).  Since the time averaged connection rate is close to zero
 #      because lonc's purpose is to maintain near continuous connnections,
 #      preforking is not really needed.
+# 08/xx/2003 Ron Fox:  Add management requests.  Management requests
+#      will be validated via a call to ValidateManager. At present, this
+#      is done by simple host verification.  In the future we can modify
+#      this function to do a certificate check.
+#      Management functions supported include:
+#       - pushing /home/httpd/lonTabs/hosts.tab
+#       - pushing /home/httpd/lonTabs/domain.tab
 ###
 
+use strict;
 use lib '/home/httpd/lib/perl/';
 use LONCAPA::Configuration;
 
 use IO::Socket;
 use IO::File;
-use Apache::File;
+#use Apache::File;
 use Symbol;
 use POSIX;
 use Crypt::IDEA;
@@ -73,10 +81,19 @@ my $DEBUG = 0;		       # Non zero to ena
 my $status='';
 my $lastlog='';
 
-my $VERSION='$Revision: 1.121 $'; #' stupid emacs
+my $VERSION='$Revision: 1.136 $'; #' stupid emacs
 my $remoteVERSION;
 my $currenthostid;
 my $currentdomainid;
+
+my $client;
+my $server;
+my $thisserver;
+
+my %hostid;
+my %hostdom;
+my %hostip;
+
 #
 #  The array below are password error strings."
 #
@@ -145,7 +162,7 @@ sub catchexception {
     $SIG{'QUIT'}='DEFAULT';
     $SIG{__DIE__}='DEFAULT';
     &logthis("<font color=red>CRITICAL: "
-     ."ABNORMAL EXIT. Child $$ for server $wasserver died through "
+     ."ABNORMAL EXIT. Child $$ for server $thisserver died through "
      ."a crash with this error msg->[$error]</font>");
     &logthis('Famous last words: '.$status.' - '.$lastlog);
     if ($client) { print $client "error: $error\n"; }
@@ -171,8 +188,8 @@ undef $perlvarref;
 # ----------------------------- Make sure this process is running from user=www
 my $wwwid=getpwnam('www');
 if ($wwwid!=$<) {
-   $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";
-   $subj="LON: $currenthostid User ID mismatch";
+   my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";
+   my $subj="LON: $currenthostid User ID mismatch";
    system("echo 'User ID mismatch.  lond must be run as user www.' |\
  mailto $emailto -s '$subj' > /dev/null");
    exit 1;
@@ -189,20 +206,17 @@ if (-e $pidfile) {
    if (kill 0 => $pide) { die "already running"; }
 }
 
-$PREFORK=4; # number of children to maintain, at least four spare
-
 # ------------------------------------------------------------- Read hosts file
 
 open (CONFIG,"$perlvar{'lonTabDir'}/hosts.tab") || die "Can't read host file";
 
-while ($configline=<CONFIG>) {
+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; }
-    $PREFORK++;
 }
 close(CONFIG);
 
@@ -218,10 +232,8 @@ $server = IO::Socket::INET->new(LocalPor
 
 # global variables
 
-$MAX_CLIENTS_PER_CHILD  = 50;        # number of clients each child should 
-                                    # process
-%children               = ();       # keys are current child process IDs
-$children               = 0;        # current number of children
+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;
@@ -250,8 +262,8 @@ sub HUPSMAN {                      # sig
     kill 'INT' => keys %children;
     &logthis("Free socket: ".shutdown($server,2)); # free up socket
     &logthis("<font color=red>CRITICAL: Restarting</font>");
-    unlink("$execdir/logs/lond.pid");
     my $execdir=$perlvar{'lonDaemons'};
+    unlink("$execdir/logs/lond.pid");
     exec("$execdir/lond");         # here we go again
 }
 
@@ -259,7 +271,7 @@ sub checkchildren {
     &initnewstatus();
     &logstatus();
     &logthis('Going to check on the children');
-    $docdir=$perlvar{'lonDocRoot'};
+    my $docdir=$perlvar{'lonDocRoot'};
     foreach (sort keys %children) {
 	sleep 1;
         unless (kill 'USR1' => $_) {
@@ -276,11 +288,11 @@ sub checkchildren {
             alarm(300);
 	    &logthis('Child '.$_.' did not respond');
 	    kill 9 => $_;
-	    $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";
-	    $subj="LON: $currenthostid killed lond process $_";
-	    my $result=`echo 'Killed lond process $_.' | mailto $emailto -s '$subj' > /dev/null`;
-	    $execdir=$perlvar{'lonDaemons'};
-	    $result=`/bin/cp $execdir/logs/lond.log $execdir/logs/lond.log.$_`;
+	    #$emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";
+	    #$subj="LON: $currenthostid killed lond process $_";
+	    #my $result=`echo 'Killed lond process $_.' | mailto $emailto -s '$subj' > /dev/null`;
+	    #$execdir=$perlvar{'lonDaemons'};
+	    #$result=`/bin/cp $execdir/logs/lond.log $execdir/logs/lond.log.$_`;
 	    alarm(0);
 	  }
         }
@@ -331,7 +343,7 @@ sub initnewstatus {
     my $local=localtime($now);
     print $fh "LOND status $local - parent $$\n\n";
     opendir(DIR,"$docdir/lon-status/londchld");
-    while ($filename=readdir(DIR)) {
+    while (my $filename=readdir(DIR)) {
         unlink("$docdir/lon-status/londchld/$filename");
     }
     closedir(DIR);
@@ -375,13 +387,6 @@ sub reconlonc {
         if (kill 0 => $loncpid) {
 	    &logthis("lonc at pid $loncpid responding, sending USR1");
             kill USR1 => $loncpid;
-            sleep 5;
-            if (-e "$peerfile") { return; }
-            &logthis("$peerfile still not there, give it another try");
-            sleep 10;
-            if (-e "$peerfile") { return; }
-            &logthis(
- "<font color=blue>WARNING: $peerfile still not there, giving up</font>");
         } else {
 	    &logthis(
               "<font color=red>CRITICAL: "
@@ -480,7 +485,7 @@ sub ishome {
 # ======================================================= Continue main program
 # ---------------------------------------------------- Fork once and dissociate
 
-$fpid=fork;
+my $fpid=fork;
 exit if $fpid;
 die "Couldn't fork: $!" unless defined ($fpid);
 
@@ -488,7 +493,7 @@ POSIX::setsid() or die "Can't start new
 
 # ------------------------------------------------------- Write our PID on disk
 
-$execdir=$perlvar{'lonDaemons'};
+my $execdir=$perlvar{'lonDaemons'};
 open (PIDSAVE,">$execdir/logs/lond.pid");
 print PIDSAVE "$$\n";
 close(PIDSAVE);
@@ -518,7 +523,6 @@ while (1) {
 }
 
 sub make_new_child {
-    my $client;
     my $pid;
     my $cipher;
     my $sigset;
@@ -529,7 +533,8 @@ sub make_new_child {
     $sigset = POSIX::SigSet->new(SIGINT);
     sigprocmask(SIG_BLOCK, $sigset)
         or die "Can't block SIGINT for fork: $!\n";
-    
+
+    my $clientip;
     die "fork: $!" unless defined ($pid = fork);
     
     if ($pid) {
@@ -543,6 +548,8 @@ sub make_new_child {
     } else {
         # Child can *not* return from this subroutine.
         $SIG{INT} = 'DEFAULT';      # make SIGINT kill us as it did before
+        $SIG{CHLD} = 'DEFAULT'; #make this default so that pwauth returns 
+                                #don't get intercepted
         $SIG{USR1}= \&logstatus;
         $SIG{ALRM}= \&timeout;
         $lastlog='Forked ';
@@ -552,7 +559,7 @@ sub make_new_child {
         sigprocmask(SIG_UNBLOCK, $sigset)
             or die "Can't unblock SIGINT for fork: $!\n";
 
-        $tmpsnum=0;
+        my $tmpsnum=0;
 #---------------------------------------------------- kerberos 5 initialization
         &Authen::Krb5::init_context();
         &Authen::Krb5::init_ets();
@@ -566,7 +573,7 @@ sub make_new_child {
             # see if we know client and check for spoof IP by challenge
 		my $caller = getpeername($client);
             my ($port,$iaddr)=unpack_sockaddr_in($caller);
-            my $clientip=inet_ntoa($iaddr);
+            $clientip=inet_ntoa($iaddr);
             my $clientrec=($hostid{$clientip} ne undef);
             &logthis(
 "<font color=yellow>INFO: Connection, $clientip ($hostid{$clientip})</font>"
@@ -646,7 +653,7 @@ sub make_new_child {
                        print $client "$currenthostid\n";
 # ------------------------------------------------------------------------ pong
 		   } elsif ($userinput =~ /^pong/) {
-                       $reply=reply("ping",$hostid{$clientip});
+                       my $reply=&reply("ping",$hostid{$clientip});
                        print $client "$currenthostid:$reply\n"; 
 # ------------------------------------------------------------------------ ekey
 		   } elsif ($userinput =~ /^ekey/) {
@@ -670,8 +677,12 @@ sub make_new_child {
                           $loadavg=<$loadfile>;
                        }
                        $loadavg =~ s/\s.*//g;
-                       my $loadpercent=100*$loadavg/$perlvar{'lonLoadLim'};
+		       my $loadpercent=100*$loadavg/$perlvar{'lonLoadLim'};
 		       print $client "$loadpercent\n";
+# -------------------------------------------------------------------- userload
+		   } elsif ($userinput =~ /^userload/) {
+		       my $userloadpercent=&userload();
+		       print $client "$userloadpercent\n";
 # ----------------------------------------------------------------- currentauth
 		   } elsif ($userinput =~ /^currentauth/) {
 		     if ($wasenc==1) {
@@ -726,7 +737,7 @@ sub make_new_child {
 			      }
 			      }
                           } elsif ($howpwd eq 'krb4') {
-                              $null=pack("C",0);
+                              my $null=pack("C",0);
                               unless ($upass=~/$null/) {
                                   my $krb4_error = &Authen::Krb4::get_pw_in_tkt
                                       ($uname,"",$contentpwd,'krbtgt',
@@ -743,7 +754,7 @@ sub make_new_child {
                                   }
                               }
                           } elsif ($howpwd eq 'krb5') {
-			      $null=pack("C",0);
+			      my $null=pack("C",0);
 			      unless ($upass=~/$null/) {
 				  my $krbclient=&Authen::Krb5::parse_name($uname.'@'.$contentpwd);
 				  my $krbservice="krbtgt/".$contentpwd."\@".$contentpwd;
@@ -827,7 +838,7 @@ sub make_new_child {
 			     if ($pwdcorrect) {
 				 my $execdir=$perlvar{'lonDaemons'};
 				 &Debug("Opening lcpasswd pipeline");
-				 my $pf = IO::File->new("|$execdir/lcpasswd > /home/www/lcpasswd.log");
+				 my $pf = IO::File->new("|$execdir/lcpasswd > $perlvar{'lonDaemons'}/logs/lcpasswd.log");
 				 print $pf "$uname\n$npass\n$npass\n";
 				 close $pf;
 				 my $err = $?;
@@ -868,10 +879,10 @@ sub make_new_child {
                        } elsif ($udom ne $currentdomainid) {
                            print $client "not_right_domain\n";
                        } else {
-                           @fpparts=split(/\//,$proname);
-                           $fpnow=$fpparts[0].'/'.$fpparts[1].'/'.$fpparts[2];
-                           $fperror='';
-                           for ($i=3;$i<=$#fpparts;$i++) {
+                           my @fpparts=split(/\//,$proname);
+                           my $fpnow=$fpparts[0].'/'.$fpparts[1].'/'.$fpparts[2];
+                           my $fperror='';
+                           for (my $i=3;$i<=$#fpparts;$i++) {
                                $fpnow.='/'.$fpparts[$i]; 
                                unless (-e $fpnow) {
 				   unless (mkdir($fpnow,0777)) {
@@ -935,11 +946,11 @@ sub make_new_child {
                               $uid,$gid,$rdev,$size,
                               $atime,$mtime,$ctime,
                               $blksize,$blocks)=stat($fname);
-                          $now=time;
-                          $since=$now-$atime;
+                          my $now=time;
+                          my $since=$now-$atime;
                           if ($since>$perlvar{'lonExpire'}) {
-                              $reply=
-                                    reply("unsub:$fname","$hostid{$clientip}");
+                              my $reply=
+                                    &reply("unsub:$fname","$hostid{$clientip}");
                               unlink("$fname");
                           } else {
 			     my $transname="$fname.in.transfer";
@@ -1010,16 +1021,16 @@ sub make_new_child {
                    } elsif ($userinput =~ /^tokenauthuserfile/) {
                        my ($cmd,$fname,$session)=split(/:/,$userinput);
                        chomp($session);
-                       $reply='non_auth';
+                       my $reply='non_auth';
                        if (open(ENVIN,$perlvar{'lonIDsDir'}.'/'.
-                                      $session.'.id')) {
-                        while ($line=<ENVIN>) {
-			   if ($line=~/userfile\.$fname\=/) { $reply='ok'; }
-                        }
-                        close(ENVIN);
-                        print $client $reply."\n";
+				$session.'.id')) {
+			   while (my $line=<ENVIN>) {
+			       if ($line=~/userfile\.$fname\=/) { $reply='ok'; }
+			   }
+			   close(ENVIN);
+			   print $client $reply."\n";
 		       } else {
-			print $client "invalid_token\n";
+			   print $client "invalid_token\n";
                        }
 # ----------------------------------------------------------------- unsubscribe
                    } elsif ($userinput =~ /^unsub/) {
@@ -1070,9 +1081,10 @@ sub make_new_child {
 			       ) { print $hfh "P:$now:$what\n"; }
 		       }
                        my @pairs=split(/\&/,$what);
-      if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) {
-                           foreach $pair (@pairs) {
-			       ($key,$value)=split(/=/,$pair);
+		       my %hash;
+		       if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) {
+                           foreach my $pair (@pairs) {
+			       my ($key,$value)=split(/=/,$pair);
                                $hash{$key}=$value;
                            }
 			   if (untie(%hash)) {
@@ -1112,14 +1124,14 @@ sub make_new_child {
                                  }
 		       }
                        my @pairs=split(/\&/,$what);
-      if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) {
-                           foreach $pair (@pairs) {
-			       ($key,$value)=split(/=/,$pair);
+		       my %hash;
+		       if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) {
+                           foreach my $pair (@pairs) {
+			       my ($key,$value)=split(/=/,$pair);
 			       &ManagePermissions($key, $udom, $uname,
 						  &GetAuthType( $udom, 
 								$uname));
                                $hash{$key}=$value;
-			       
                            }
 			   if (untie(%hash)) {
                               print $client "ok\n";
@@ -1158,10 +1170,10 @@ sub make_new_child {
                                  }
 		       }
                        my @rolekeys=split(/\&/,$what);
-      if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) {
-                           foreach $key (@rolekeys) {
+		       my %hash;
+		       if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) {
+                           foreach my $key (@rolekeys) {
                                delete $hash{$key};
-			       
                            }
 			   if (untie(%hash)) {
                               print $client "ok\n";
@@ -1188,8 +1200,9 @@ sub make_new_child {
                        my @queries=split(/\&/,$what);
                        my $proname=propath($udom,$uname);
                        my $qresult='';
-      if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER(),0640)) {
-                           for ($i=0;$i<=$#queries;$i++) {
+		       my %hash;
+		       if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER(),0640)) {
+                           for (my $i=0;$i<=$#queries;$i++) {
                                $qresult.="$hash{$queries[$i]}&";
                            }
 			   if (untie(%hash)) {
@@ -1220,8 +1233,9 @@ sub make_new_child {
                        my @queries=split(/\&/,$what);
                        my $proname=propath($udom,$uname);
                        my $qresult='';
-      if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER(),0640)) {
-                           for ($i=0;$i<=$#queries;$i++) {
+		       my %hash;
+		       if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER(),0640)) {
+                           for (my $i=0;$i<=$#queries;$i++) {
                                $qresult.="$hash{$queries[$i]}&";
                            }
 			   if (untie(%hash)) {
@@ -1266,8 +1280,9 @@ sub make_new_child {
 			       ) { print $hfh "D:$now:$what\n"; }
 		       }
                        my @keys=split(/\&/,$what);
-      if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) {
-                           foreach $key (@keys) {
+		       my %hash;
+		       if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) {
+                           foreach my $key (@keys) {
                                delete($hash{$key});
                            }
 			   if (untie(%hash)) {
@@ -1290,8 +1305,9 @@ sub make_new_child {
                        $namespace=~s/\W//g;
                        my $proname=propath($udom,$uname);
                        my $qresult='';
-      if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER(),0640)) {
-                           foreach $key (keys %hash) {
+		       my %hash;
+		       if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER(),0640)) {
+                           foreach my $key (keys %hash) {
                                $qresult.="$key&";
                            }
 			   if (untie(%hash)) {
@@ -1315,6 +1331,7 @@ sub make_new_child {
                        $namespace=~s/\W//g;
                        my $qresult='';
                        my $proname=propath($udom,$uname);
+		       my %hash;
                        if (tie(%hash,'GDBM_File',
                                "$proname/$namespace.db",
                                &GDBM_READER(),0640)) {
@@ -1365,9 +1382,10 @@ sub make_new_child {
 		       }
                        my $qresult='';
                        my $proname=propath($udom,$uname);
-    if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER(),0640)) {
+		       my %hash;
+		       if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER(),0640)) {
                            study($regexp);
-                           while (($key,$value) = each(%hash)) {
+                           while (my ($key,$value) = each(%hash)) {
                                if ($regexp eq '.') {
                                    $qresult.=$key.'='.$value.'&';
                                } else {
@@ -1407,15 +1425,15 @@ sub make_new_child {
 			       ) { print $hfh "P:$now:$rid:$what\n"; }
 		       }
                        my @pairs=split(/\&/,$what);
-                         
-    if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) {
+		       my %hash;
+		       if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT(),0640)) {
                            my @previouskeys=split(/&/,$hash{"keys:$rid"});
                            my $key;
                            $hash{"version:$rid"}++;
                            my $version=$hash{"version:$rid"};
                            my $allkeys=''; 
-                           foreach $pair (@pairs) {
-			       ($key,$value)=split(/=/,$pair);
+                           foreach my $pair (@pairs) {
+			       my ($key,$value)=split(/=/,$pair);
                                $allkeys.=$key.':';
                                $hash{"$version:$rid:$key"}=$value;
                            }
@@ -1446,7 +1464,8 @@ sub make_new_child {
                        chomp($rid);
                        my $proname=propath($udom,$uname);
                        my $qresult='';
-      if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER(),0640)) {
+		       my %hash;
+		       if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_READER(),0640)) {
                 	   my $version=$hash{"version:$rid"};
                            $qresult.="version=$version&";
                            my $scope;
@@ -1479,9 +1498,10 @@ sub make_new_child {
                        print $client "ok\n";
 # -------------------------------------------------------------------- chatretr
                    } elsif ($userinput =~ /^chatretr/) {
-                       my ($cmd,$cdom,$cnum)=split(/\:/,$userinput);
+                       my 
+                        ($cmd,$cdom,$cnum,$udom,$uname)=split(/\:/,$userinput);
                        my $reply='';
-                       foreach (&getchat($cdom,$cnum)) {
+                       foreach (&getchat($cdom,$cnum,$udom,$uname)) {
 			   $reply.=&escape($_).':';
                        }
                        $reply=~s/\:$//;
@@ -1522,9 +1542,10 @@ sub make_new_child {
                               "$perlvar{'lonUsersDir'}/$udom/nohist_courseids";
                        my $now=time;
                        my @pairs=split(/\&/,$what);
-                 if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT(),0640)) {
-                           foreach $pair (@pairs) {
-			       ($key,$value)=split(/=/,$pair);
+		       my %hash;
+		       if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT(),0640)) {
+                           foreach my $pair (@pairs) {
+			       my ($key,$value)=split(/=/,$pair);
                                $hash{$key}=$value.':'.$now;
                            }
 			   if (untie(%hash)) {
@@ -1552,11 +1573,12 @@ sub make_new_child {
                        my $qresult='';
                        my $proname=
                               "$perlvar{'lonUsersDir'}/$udom/nohist_courseids";
-                if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_READER(),0640)) {
-                           while (($key,$value) = each(%hash)) {
+		       my %hash;
+		       if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_READER(),0640)) {
+                           while (my ($key,$value) = each(%hash)) {
                                my ($descr,$lasttime)=split(/\:/,$value);
                                if ($lasttime<$since) { next; }
-                               if ($regexp eq '.') {
+                               if ($description eq '.') {
                                    $qresult.=$key.'='.$descr.'&';
                                } else {
                                    my $unescapeVal = &unescape($descr);
@@ -1592,9 +1614,10 @@ sub make_new_child {
 			       ) { print $hfh "P:$now:$what\n"; }
 		       }
                        my @pairs=split(/\&/,$what);
-                 if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT(),0640)) {
-                           foreach $pair (@pairs) {
-			       ($key,$value)=split(/=/,$pair);
+		       my %hash;
+		       if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_WRCREAT(),0640)) {
+                           foreach my $pair (@pairs) {
+			       my ($key,$value)=split(/=/,$pair);
                                $hash{$key}=$value;
                            }
 			   if (untie(%hash)) {
@@ -1617,17 +1640,18 @@ sub make_new_child {
                        my $proname="$perlvar{'lonUsersDir'}/$udom/ids";
                        my @queries=split(/\&/,$what);
                        my $qresult='';
-                 if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_READER(),0640)) {
-                           for ($i=0;$i<=$#queries;$i++) {
+		       my %hash;
+		       if (tie(%hash,'GDBM_File',"$proname.db",&GDBM_READER(),0640)) {
+                           for (my $i=0;$i<=$#queries;$i++) {
                                $qresult.="$hash{$queries[$i]}&";
                            }
 			   if (untie(%hash)) {
-		              $qresult=~s/\&$//;
-                              print $client "$qresult\n";
+			       $qresult=~s/\&$//;
+			       print $client "$qresult\n";
                            } else {
-                              print $client "error: ".($!+0)
-				  ." untie(GDBM) Failed ".
-                                      "while attempting idget\n";
+			       print $client "error: ".($!+0)
+				   ." untie(GDBM) Failed ".
+				       "while attempting idget\n";
                            }
                        } else {
                            print $client "error: ".($!+0)
@@ -1709,6 +1733,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/)) {
@@ -1772,11 +1809,11 @@ 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" ;
-	Debug("system $execdir/lchtmldir $userhome $system $authtype");
+	&logthis("system $execdir/lchtmldir $userhome $user $authtype");
 	system("$execdir/lchtmldir $userhome $user $authtype");
     }
 }
@@ -1819,6 +1856,7 @@ sub addline {
     my $found=0;
     my $expr='^'.$hostid.':'.$ip.':';
     $expr =~ s/\./\\\./g;
+    my $sh;
     if ($sh=IO::File->new("$fname.subscription")) {
 	while (my $subline=<$sh>) {
 	    if ($subline !~ /$expr/) {$contents.= $subline;} else {$found=1;}
@@ -1833,7 +1871,7 @@ sub addline {
 }
 
 sub getchat {
-    my ($cdom,$cname)=@_;
+    my ($cdom,$cname,$udom,$uname)=@_;
     my %hash;
     my $proname=&propath($cdom,$cname);
     my @entries=();
@@ -1842,7 +1880,19 @@ sub getchat {
 	@entries=map { $_.':'.$hash{$_} } sort keys %hash;
 	untie %hash;
     }
-    return @entries;
+    my @participants=();
+    my $cutoff=time-60;
+    if (tie(%hash,'GDBM_File',"$proname/nohist_inchatroom.db",
+	    &GDBM_WRCREAT(),0640)) {
+        $hash{$uname.':'.$udom}=time;
+        foreach (sort keys %hash) {
+	    if ($hash{$_}>$cutoff) {
+		$participants[$#participants+1]='active_participant:'.$_;
+            }
+        }
+        untie %hash;
+    }
+    return (@participants,@entries);
 }
 
 sub chatadd {
@@ -1909,24 +1959,24 @@ sub currentversion {
     }
     if (-e $fname) { $version=1; }
     if (-e $ulsdir) {
-       if(-d $ulsdir) {
-          if (opendir(LSDIR,$ulsdir)) {
-
-             while ($ulsfn=readdir(LSDIR)) {
+	if(-d $ulsdir) {
+	    if (opendir(LSDIR,$ulsdir)) {
+		my $ulsfn;
+		while ($ulsfn=readdir(LSDIR)) {
 # see if this is a regular file (ignore links produced earlier)
-                 my $thisfile=$ulsdir.'/'.$ulsfn;
-                 unless (-l $thisfile) {
-		     if ($thisfile=~/\Q$fnamere1\E(\d+)\Q$fnamere2\E/) {
-			 if ($1>$version) { $version=$1; }
-		     }
-		 }
-             }
-             closedir(LSDIR);
-             $version++;
-          }
-      }
-   }
-   return $version;
+		    my $thisfile=$ulsdir.'/'.$ulsfn;
+		    unless (-l $thisfile) {
+			if ($thisfile=~/\Q$fnamere1\E(\d+)\Q$fnamere2\E/) {
+			    if ($1>$version) { $version=$1; }
+			}
+		    }
+		}
+		closedir(LSDIR);
+		$version++;
+	    }
+	}
+    }
+    return $version;
 }
 
 sub thisversion {
@@ -1965,7 +2015,7 @@ sub subscribe {
 		$result="directory\n";
 	    } else {
 		if (-e "$fname.$hostid{$clientip}") {&unsub($fname,$clientip);}
-		$now=time;
+		my $now=time;
 		my $found=&addline($fname,$hostid{$clientip},$clientip,
 				   "$hostid{$clientip}:$clientip:$now\n");
 		if ($found) { $result="$fname\n"; }
@@ -2014,7 +2064,7 @@ sub make_passwd_file {
 	    {
 		&Debug("Executing external: ".$execpath);
 		&Debug("user  = ".$uname.", Password =". $npass);
-		my $se = IO::File->new("|$execpath > /home/www/lcuseradd.log");
+		my $se = IO::File->new("|$execpath > $perlvar{'lonDaemons'}/logs/lcuseradd.log");
 		print $se "$uname\n";
 		print $se "$npass\n";
 		print $se "$npass\n";
@@ -2059,6 +2109,29 @@ sub version {
     return "version:$VERSION";
 }
 
+#There is a copy of this in lonnet.pm
+sub userload {
+    my $numusers=0;
+    {
+	opendir(LONIDS,$perlvar{'lonIDsDir'});
+	my $filename;
+	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++; }
+	}
+	closedir(LONIDS);
+    }
+    my $userloadpercent=0;
+    my $maxuserload=$perlvar{'lonUserLoadLim'};
+    if ($maxuserload) {
+	$userloadpercent=100*$numusers/$maxuserload;
+    }
+    $userloadpercent=sprintf("%.2f",$userloadpercent);
+    return $userloadpercent;
+}
+
 # ----------------------------------- POD (plain old documentation, CPAN style)
 
 =head1 NAME
@@ -2328,6 +2401,17 @@ Send along temporarily stored informatio
 
 List part of a user's directory.
 
+=item pushtable
+
+Pushes a file in /home/httpd/lonTab directory.  Currently limited to:
+hosts.tab and domain.tab. The old file is copied to  *.tab.backup but
+must be restored manually in case of a problem with the new table file.
+pushtable requires that the request be encrypted and validated via
+ValidateManager.  The form of the command is:
+enc:pushtable tablename <tablecontents> \n
+where pushtable, tablename and <tablecontents> will be encrypted, but \n is a 
+cleartext newline.
+
 =item Hanging up (exit or init)
 
 What to do when a client tells the server that they (the client)
@@ -2338,6 +2422,7 @@ are leaving the network.
 If B<lond> is sent an unknown command (not in the list above),
 it replys to the client "unknown_cmd".
 
+
 =item UNKNOWN CLIENT
 
 If the anti-spoofing algorithm cannot verify the client,