--- loncom/lond	2000/01/12 19:30:43	1.7
+++ loncom/lond	2000/06/26 02:42:28	1.12
@@ -4,7 +4,8 @@
 # 5/26/99,6/4,6/10,6/11,6/14,6/15,6/26,6/28,6/30,
 # 7/8,7/9,7/10,7/12,7/17,7/19,9/21,
 # 10/7,10/8,10/9,10/11,10/13,10/15,11/4,11/16,
-# 12/7,12/15,01/06,01/11,01/12 Gerd Kortemeyer
+# 12/7,12/15,01/06,01/11,01/12,01/14,2/8,
+# 03/07,05/31 Gerd Kortemeyer
 # based on "Perl Cookbook" ISBN 1-56592-243-3
 # preforker - server who forks first
 # runs as a daemon
@@ -79,7 +80,7 @@ sub HUNTSMAN {                      # si
     kill 'INT' => keys %children;
     my $execdir=$perlvar{'lonDaemons'};
     unlink("$execdir/logs/lond.pid");
-    &logthis("Shutting down");
+    &logthis("<font color=red>CRITICAL: Shutting down</font>");
     exit;                           # clean up with dignity
 }
 
@@ -87,7 +88,7 @@ sub HUPSMAN {                      # sig
     local($SIG{CHLD}) = 'IGNORE';  # we're going to kill our children
     kill 'INT' => keys %children;
     close($server);                # free up socket
-    &logthis("Restarting");
+    &logthis("<font color=red>CRITICAL: Restarting</font>");
     my $execdir=$perlvar{'lonDaemons'};
     exec("$execdir/lond");         # here we go again
 }
@@ -103,6 +104,23 @@ sub logthis {
     print $fh "$local ($$): $message\n";
 }
 
+
+# -------------------------------------------------------- Escape Special Chars
+
+sub escape {
+    my $str=shift;
+    $str =~ s/(\W)/"%".unpack('H2',$1)/eg;
+    return $str;
+}
+
+# ----------------------------------------------------- Un-Escape Special Chars
+
+sub unescape {
+    my $str=shift;
+    $str =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C",hex($1))/eg;
+    return $str;
+}
+
 # ----------------------------------------------------------- Send USR1 to lonc
 
 sub reconlonc {
@@ -120,16 +138,20 @@ sub reconlonc {
             &logthis("$peerfile still not there, give it another try");
             sleep 5;
             if (-e "$peerfile") { return; }
-            &logthis("$peerfile still not there, giving up");
+            &logthis(
+ "<font color=blue>WARNING: $peerfile still not there, giving up</font>");
         } else {
-	    &logthis("lonc at pid $loncpid not responding, giving up");
+	    &logthis(
+              "<font color=red>CRITICAL: "
+             ."lonc at pid $loncpid not responding, giving up</font>");
         }
     } else {
-        &logthis('lonc not running, giving up');
+      &logthis('<font color=red>CRITICAL: lonc not running, giving up</font>');
     }
 }
 
 # -------------------------------------------------- Non-critical communication
+
 sub subreply {
     my ($cmd,$server)=@_;
     my $peerfile="$perlvar{'lonSockDir'}/$server";
@@ -162,7 +184,30 @@ sub reply {
   return $answer;
 }
 
+sub sqlreply {
+    my ($cmd)=@_;
+    my $answer=subsqlreply($cmd);
+    if ($answer eq 'con_lost') { $answer=subsqlreply($cmd); }
+    return $answer;
+}
+
+sub subsqlreply {
+    my ($cmd)=@_;
+    my $unixsock="mysqlsock";
+    my $peerfile="$perlvar{'lonSockDir'}/$unixsock";
+    my $sclient=IO::Socket::UNIX->new(Peer    =>"$peerfile",
+                                      Type    => SOCK_STREAM,
+                                      Timeout => 10)
+       or return "con_lost";
+    print $sclient "$cmd\n";
+    my $answer=<$sclient>;
+    chomp($answer);
+    if (!$answer) { $answer="con_lost"; }
+    return $answer;
+}
+
 # -------------------------------------------- Return path to profile directory
+
 sub propath {
     my ($udom,$uname)=@_;
     $udom=~s/\W//g;
@@ -174,6 +219,7 @@ sub propath {
 } 
 
 # --------------------------------------- Is this the home server of an author?
+
 sub ishome {
     my $author=shift;
     $author=~s/\/home\/httpd\/html\/res\/([^\/]*)\/([^\/]*).*/$1\/$2/;
@@ -201,7 +247,7 @@ $execdir=$perlvar{'lonDaemons'};
 open (PIDSAVE,">$execdir/logs/lond.pid");
 print PIDSAVE "$$\n";
 close(PIDSAVE);
-&logthis("Starting");
+&logthis("<font color=red>CRITICAL: ---------- Starting ----------</font>");
 
 # ------------------------------------------------------- Now we are on our own
     
@@ -263,7 +309,8 @@ sub make_new_child {
             my ($port,$iaddr)=unpack_sockaddr_in($caller);
             my $clientip=inet_ntoa($iaddr);
             my $clientrec=($hostid{$clientip} ne undef);
-            &logthis("Connect from $clientip ($hostid{$clientip})");
+            &logthis(
+"<font color=yellow>INFO: Connect from $clientip ($hostid{$clientip})</font>");
             my $clientok;
             if ($clientrec) {
 	      my $remotereq=<$client>;
@@ -277,17 +324,23 @@ sub make_new_child {
 		      $clientok=1;
                       print $client "ok\n";
                   } else {
-		      &logthis("$clientip did not reply challenge");
+		      &logthis(
+ "<font color=blue>WARNING: $clientip did not reply challenge</font>");
                   }
               } else {
-		  &logthis("$clientip failed to initialize: >$remotereq<");
+		  &logthis(
+                    "<font color=blue>WARNING: "
+                   ."$clientip failed to initialize: >$remotereq< </font>");
               }
 	    } else {
-              &logthis("Unknown client $clientip");
+              &logthis(
+ "<font color=blue>WARNING: Unknown client $clientip</font>");
             }
             if ($clientok) {
 # ---------------- New known client connecting, could mean machine online again
 	      &reconlonc("$perlvar{'lonSockDir'}/$hostid{$clientip}");
+              &logthis(
+       "<font color=green>Established connection: $hostid{$clientip}</font>");
 # ------------------------------------------------------------ Process requests
               while (my $userinput=<$client>) {
                 chomp($userinput);
@@ -344,6 +397,7 @@ sub make_new_child {
 		     if ($wasenc==1) {
                        my ($cmd,$udom,$uname,$upass)=split(/:/,$userinput);
                        chomp($upass);
+                       $upass=unescape($upass);
                        my $proname=propath($udom,$uname);
                        my $passfilename="$proname/passwd";
                        if (-e $passfilename) {
@@ -494,10 +548,26 @@ sub make_new_child {
 		       } else {
                         print $client "rejected\n";
 		       }
+# ------------------------------------------------------------------------- log
+                   } elsif ($userinput =~ /^log/) {
+                       my ($cmd,$udom,$uname,$what)=split(/:/,$userinput);
+                       chomp($what);
+                       my $proname=propath($udom,$uname);
+                       my $now=time;
+                       {
+			 my $hfh;
+			 if ($hfh=IO::File->new(">>$proname/activity.log")) { 
+                            print $hfh "$now:$hostid{$clientip}:$what\n";
+                            print $client "ok\n"; 
+			} else {
+                            print $client "error:$!\n";
+		        }
+		       }
 # ------------------------------------------------------------------------- put
                    } elsif ($userinput =~ /^put/) {
                       my ($cmd,$udom,$uname,$namespace,$what)
                           =split(/:/,$userinput);
+                      $namespace=~s/\//\_/g;
                       $namespace=~s/\W//g;
                       if ($namespace ne 'roles') {
                        chomp($what);
@@ -564,6 +634,7 @@ sub make_new_child {
                    } elsif ($userinput =~ /^get/) {
                        my ($cmd,$udom,$uname,$namespace,$what)
                           =split(/:/,$userinput);
+                       $namespace=~s/\//\_/g;
                        $namespace=~s/\W//g;
                        chomp($what);
                        my @queries=split(/\&/,$what);
@@ -586,6 +657,7 @@ sub make_new_child {
                    } elsif ($userinput =~ /^eget/) {
                        my ($cmd,$udom,$uname,$namespace,$what)
                           =split(/:/,$userinput);
+                       $namespace=~s/\//\_/g;
                        $namespace=~s/\W//g;
                        chomp($what);
                        my @queries=split(/\&/,$what);
@@ -621,6 +693,7 @@ sub make_new_child {
                    } elsif ($userinput =~ /^del/) {
                        my ($cmd,$udom,$uname,$namespace,$what)
                           =split(/:/,$userinput);
+                       $namespace=~s/\//\_/g;
                        $namespace=~s/\W//g;
                        chomp($what);
                        my $proname=propath($udom,$uname);
@@ -648,8 +721,8 @@ sub make_new_child {
                    } elsif ($userinput =~ /^keys/) {
                        my ($cmd,$udom,$uname,$namespace)
                           =split(/:/,$userinput);
+                       $namespace=~s/\//\_/g;
                        $namespace=~s/\W//g;
-                       chomp($namespace);
                        my $proname=propath($udom,$uname);
                        my $qresult='';
       if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {
@@ -669,8 +742,8 @@ sub make_new_child {
                    } elsif ($userinput =~ /^dump/) {
                        my ($cmd,$udom,$uname,$namespace)
                           =split(/:/,$userinput);
+                       $namespace=~s/\//\_/g;
                        $namespace=~s/\W//g;
-                       chomp($namespace);
                        my $proname=propath($udom,$uname);
                        my $qresult='';
       if (tie(%hash,'GDBM_File',"$proname/$namespace.db",&GDBM_WRCREAT,0640)) {
@@ -690,6 +763,7 @@ sub make_new_child {
                    } elsif ($userinput =~ /^store/) {
                       my ($cmd,$udom,$uname,$namespace,$rid,$what)
                           =split(/:/,$userinput);
+                      $namespace=~s/\//\_/g;
                       $namespace=~s/\W//g;
                       if ($namespace ne 'roles') {
                        chomp($what);
@@ -731,6 +805,7 @@ sub make_new_child {
                    } elsif ($userinput =~ /^restore/) {
                        my ($cmd,$udom,$uname,$namespace,$rid)
                           =split(/:/,$userinput);
+                       $namespace=~s/\//\_/g;
                        $namespace=~s/\W//g;
                        chomp($rid);
                        my $proname=propath($udom,$uname);
@@ -757,6 +832,24 @@ sub make_new_child {
                        } else {
                            print $client "error:$!\n";
                        }
+# ------------------------------------------------------------------- querysend
+                   } elsif ($userinput =~ /^querysend/) {
+                       my ($cmd,$query)=split(/:/,$userinput);
+                       # make sure you get one \n and only one
+		       $query=~s/\n*$//g;
+                       print $client sqlreply("$hostid{$clientip}\&$query")."\n";
+# ------------------------------------------------------------------ queryreply
+                   } elsif ($userinput =~ /^queryreply/) {
+                       my ($cmd,$id,$reply)=split(/:/,$userinput); 
+		       my $store;
+                       if ($store=IO::File->new(">/tmp/$id")) {
+			   print $store $reply;
+			   close $store;
+			   print $client "ok\n";
+		       }
+		       else {
+			   print $client "error:$!\n";
+		       }
 # ----------------------------------------------------------------------- idput
                    } elsif ($userinput =~ /^idput/) {
                        my ($cmd,$udom,$what)=split(/:/,$userinput);
@@ -828,9 +921,11 @@ sub make_new_child {
 	       }
             } else {
 	        print $client "refused\n";
-                &logthis("Rejected client $clientip, closing connection");
+                &logthis("<font color=blue>WARNING: "
+                ."Rejected client $clientip, closing connection</font>");
             }              
-            &logthis("Disconnect from $clientip ($hostid{$clientip})");
+            &logthis("<font color=red>CRITICAL: "
+                    ."Disconnect from $clientip ($hostid{$clientip})</font>");
 # =============================================================================
         }