From 8ee484099af86cd0165b2d94e6a5f9828a1362f2 Mon Sep 17 00:00:00 2001
From: waynieack <wayne@razorcla.ws>
Date: Fri, 25 Aug 2017 02:05:34 -0500
Subject: [PATCH 1/2] Fixed issue with table updates and fixed a bug with MH
 crashing on the Global Vars page.

---
 bin/mh             | 26 +++++++++++++++++++++-----
 lib/ajax.pm        |  9 ++++++---
 lib/http_server.pl | 23 +++++++++++++----------
 lib/json_server.pl | 13 +++++++++----
 4 files changed, 49 insertions(+), 22 deletions(-)

diff --git a/bin/mh b/bin/mh
index 538871896..060a57e07 100755
--- a/bin/mh
+++ b/bin/mh
@@ -133,7 +133,7 @@ my ( $user_code,              $user_code_last_good );
 my ( %objects_by_object_name, %file_by_object_name, %files_by_webname );
 my ( %object_names_by_file,   %object_names_by_type, %object_names_by_webname, $pause_mode );
 my ( @Server_Ports,           @Generic_Devices, %Local_Addresses, @Local_Addresses, %Passwords, @Password_Allow_Clients );
-my ( %proxy_servers,          %app_parms );
+my ( %proxy_servers,          %app_parms, %waiter_flags );
 my ( $CON_IN,                 $CON_OUT );
 
 my ( $state, $temp );        # Some generic useful vars
@@ -2556,16 +2556,20 @@ sub check_for_socket_data_http {
 
         # See if there is a http request
         my $nfound = &socket_has_data( $Socket_Ports{http}{sock} );
+	#print "http: below nfound ....\n" if $Debug{http};
         last unless $nfound > 0;            # nfound = -1 means an error occurred
+	#print "http: below last unless  nfound ....\n" if $Debug{http};
         my $sock = $Socket_Ports{http}{sock}->accept();
+	#print "http: below sock ....\n" if $Debug{http};
         last unless $sock;                  # Can be undef it socket was killed
+	#print "http: below last unless sock ....\n" if $Debug{http};
         $sock->autoflush(1);                # Not sure if this does anything?
         $Socket_Ports{http}{socka} = $sock;
 
         ( $leave_socket_open_passes, $leave_socket_open_action ) = &http_process_request($sock);
 
         my $time_diff = time - $time_check;
-        print "http: c=$loop_count td=$time_diff sop=$leave_socket_open_passes soa=$leave_socket_open_action.\n"
+        print "http: c=$loop_count td=$time_diff sop=$leave_socket_open_passes soa=$leave_socket_open_action. while loop\n"
           if $Debug{http};
 
         if ($leave_socket_open_action) {
@@ -2580,6 +2584,7 @@ sub check_for_socket_data_http {
                 # We must sleep here for a bit, or else Netscape sometimes
                 # says 'Document contains no data'.  Guess we don't need this anymore :)
                 #               select undef, undef, undef, .010;
+		print "http: closing socket - ". $Info{'http_socket'}->peer ." ....\n" if $Debug{http};
                 &socket_close('http');
             }
         }
@@ -6813,9 +6818,8 @@ sub socket_has_data {
     my $loopmax = 8;
     do {
         ($nfound) = select( $rbit, undef, undef, $timeout );
-        last
-          if $nfound == -1
-          and !( $!{EINTR} );                # break out of the retry loop if an error did occur but not EINTR
+	#&::print_log("http: in socket_has_data do loop");
+        last if $nfound == -1 and !( $!{EINTR} );          # break out of the retry loop if an error did occur but not EINTR
         $loopmax--;
     } until ( $loopmax == 0 or ( $nfound >= 0 ) );
 
@@ -7757,6 +7761,18 @@ sub log_inc {
     print_log( 'Perl @INC contains: ' . join( ", ", @INC ) );
 }
 
+sub set_waiter_flags {
+    my ($flag,$value) = @_; 
+    $waiter_flags{$flag} = $value;
+}
+
+sub get_waiter_flags {
+   my ($flag) = @_;
+   $waiter_flags{$flag} = 0 unless (exists $waiter_flags{$flag});
+   return $waiter_flags{$flag};
+}
+
+
 #---------------------------------------------------------------------------
 
 # Lets do it.  Note, we put this at the bottom so
diff --git a/lib/ajax.pm b/lib/ajax.pm
index e4721fa7a..1f4893499 100644
--- a/lib/ajax.pm
+++ b/lib/ajax.pm
@@ -98,7 +98,8 @@ sub checkForUpdate {
     }
 
     if ($xml) {
-        &main::print_log("checkForUpdate sub ${$$self{sub}} returned $xml") if $main::Debug{ajax};
+        #&main::print_log("checkForUpdate sub ${$$self{sub}} returned $xml") if $main::Debug{ajax};
+        &main::print_log("checkForUpdate sub ${$$self{sub}} returned data") if $main::Debug{ajax};
         &::print_socket_fork( ${ $$self{waitingSocket} }, $xml, 1 );
         # No need to close the socket with HTTP1.1, also this causes issues with a forked socket
         #&main::print_log( "Closing Socket " . ${ $$self{waitingSocket} } ) if $main::Debug{ajax};
@@ -188,17 +189,19 @@ sub checkWaiters {
     my ($class) = @_;
     my $delay = 250;
     my $currenttime = &main::get_tickcount;
+    my $push_flag = &::get_waiter_flags('push_flag');
     foreach my $key ( keys %waiters ) {
 	my $self = $waiters{$key};
-	next unless ( ($currenttime - ${ $$self{checkTime} }) >= $delay );
+	next unless ( ( ($currenttime - ${ $$self{checkTime} }) >= $delay ) || $push_flag );
 	${ $$self{checkTime} } = $currenttime; 
-	#&main::print_log("waiter: checkWaiters checking sub sub ".${$$self{sub}} ) if $main::Debug{ajax};
+	#&main::print_log("waiter: checkWaiters Push flag: $push_flag checking sub sub ".${$$self{sub}} ) if $main::Debug{ajax} and $push_flag;
         if ( $waiters{$key}->checkForUpdate ) {
             # waiter can be removed
             delete $waiters{$key};
             &main::print_log("waiter '$key' removed") if $main::Debug{ajax};
         }
     }
+  &::set_waiter_flags('push_flag',0);
 }
 
 sub setWaiterToChanged {
diff --git a/lib/http_server.pl b/lib/http_server.pl
index f9a9b6f89..480b80e76 100644
--- a/lib/http_server.pl
+++ b/lib/http_server.pl
@@ -928,17 +928,17 @@ sub test_for_file {
     }
 
     if ( -e $file ) {
-        my $html = &html_file( $socket, $file, $get_arg, $no_header )
-          if &test_file_req( $socket, $get_req, $http_dir );
+        my $html = &html_file( $socket, $file, $get_arg, $no_header ) if &test_file_req( $socket, $get_req, $http_dir );
+
         if ($no_print) {
             return $html;
         }
         else {
-	    print "http: Test_for_file printing\n";
 	    $html = AddContentLength($html); 
             &print_socket_fork( $socket, $html );
             return 1;
         }
+
     }
     else {
         return 0;    # No file found ... check for other types of http requests
@@ -950,15 +950,15 @@ sub AddContentLength {
  my $original_html = $html;
  my $html_head;
    if ( ($html =~ /HTTP\/1\.1 200 OK/) and !($html =~ /Content-Length:/) ) {
-       print "http: header match!\n";
+       print "http: AddContentLength found http 1.1 header with out Content-Length\n" if $main::Debug{http};
 	unless ($html =~ s/^HTTP.+?^\r\n//smi) { return $original_html }
-	print "http: header striped\n";
+	print "http: AddContentLength removed header to caculate Content-Length\n" if $main::Debug{http};
 
 	my $length = length($html);
 	return $original_html unless $length;
 
 	if ($original_html =~ s/(Server: MisterHouse)\r\n/$1\r\nContent-Length: $length\r\n/) { return $original_html }
-	print "http: server not found in header\n";
+	print "http: \"Server: MisterHouse\" was not found in header so Content-Length could not be added\n" if $main::Debug{http};
 	return $original_html;
    } else { 
 	return $original_html;
@@ -2964,7 +2964,7 @@ sub pretty_object_name {
 
 # Avoid mh pauses by printing to slow remote clients with a 'forked' program
 sub print_socket_fork {
-    my ( $socket, $html ) = @_;
+    my ( $socket, $html, $close ) = @_;
     return unless $html;
     my $length = length $html;
     $socket_fork_data{length} = $length;
@@ -3015,13 +3015,15 @@ sub print_socket_fork {
             $keep_alive = 1
               if (  ( defined $Http{Connection} )
                 and ( $Http{Connection} eq "keep-alive" ) );
-            &print_socket_fork_unix( $socket, $html );
+            &print_socket_fork_unix( $socket, $html, $close );
         }
     }
     else {
         print "http: printing with regular socket l=$length s=$socket\n"
           if $main::Debug{http};
         print $socket $html;
+	$socket->shutdown(2) if $close;
+	#$leave_socket_open_passes = -1;    # This will not close the socket
     }
 }
 
@@ -3094,12 +3096,13 @@ sub print_socket_fork_win {
 
 # Forks are MUCH easier in unix :)
 sub print_socket_fork_unix {
-    my ( $socket, $html ) = @_;
+    my ( $socket, $html, $close ) = @_;
 
     my $pid = fork;
     if ( defined $pid && $pid == 0 ) {
         print $socket $html;
-        $socket->close;
+	$socket->shutdown(2) if $close;
+        $socket->close unless $close;
 
         # This avoids 'Unexpected async reply' if mh -tk 1
         &POSIX::_exit(0)
diff --git a/lib/json_server.pl b/lib/json_server.pl
index de27fbc13..b04266d89 100755
--- a/lib/json_server.pl
+++ b/lib/json_server.pl
@@ -47,6 +47,7 @@ =head2 METHODS
 use JSON qw(decode_json);
 use IO::Compress::Gzip qw(gzip);
 use vars qw(%json_table);
+my %json_cache;
 my @json_notifications = ();    #noloop
 
 sub json {
@@ -499,7 +500,7 @@ sub json_get {
         # we could use &::list_groups_by_object() for each object, but that sub
         # is time consuming, particularly when called numerous times.  Instead,
         # we create a lookup table one time, saving a lot of processing time.
-        my $parent_table = build_parent_table();
+	$json_cache{parent_table} = build_parent_table() if ( !($json_cache{parent_table}) || $Reload );
 
         if ( $args{items} && $args{items}[0] ne "" ) {
             foreach my $name ( @{ $args{items} } ) {
@@ -508,7 +509,7 @@ sub json_get {
                 my $o = &get_object_by_name($name);
                 print_log "json: object name=$name ref=" . ref $o
                   if $Debug{json};
-                if ( my $data = &json_object_detail( $o, \%args, \%fields, $parent_table ) ) {
+                if ( my $data = &json_object_detail( $o, \%args, \%fields, $json_cache{parent_table} ) ) {
                     $json_data{objects}{$name} = $data;
                 }
             }
@@ -535,7 +536,7 @@ sub json_get {
                 $name =~ s/\$|\%|\&|\@//g;
                 print_log "json: object name=$name ref=" . ref $o
                   if $Debug{json};
-                if ( my $data = &json_object_detail( $o, \%args, \%fields, $parent_table ) ) {
+                if ( my $data = &json_object_detail( $o, \%args, \%fields, $json_cache{parent_table} ) ) {
                     $json_data{objects}{$name} = $data;
                 }
             }
@@ -643,6 +644,7 @@ sub json_get {
             next if $key eq 'User_Code';
 
             my $glob = $main::{$key};
+	    next if (ref($glob) eq "CODE"); 			# Fix for MH crash 
             if ( ${$glob} ) {
                 my $value = ${$glob};
                 next if $value =~ /HASH/;                             # Skip object pointers
@@ -1028,11 +1030,13 @@ sub json_walk_var {
 }
 
 sub build_parent_table {
+	print_log "json: build_parent_table running";
     my @groups;
     my %parent_table;
     for my $group_name ( &list_objects_by_type('Group') ) {
         my $group = &get_object_by_name($group_name);
         $group_name =~ s/\$|\%|\&|\@//g;
+	 print_log "json: build_parent_table group: $group_name";
         unless ( defined $group ) {
             print_log "json: build_parent_table, group_name $group_name doesn't have an object?"
               if $Debug{json};
@@ -1380,8 +1384,9 @@ sub json_table_push {
     my ($key) = @_;
 
     return 0 if ( !defined $json_table{$key} );
-
+    	
     $json_table{$key}{time} = &get_tickcount;
+    &::set_waiter_flags('push_flag',1);
     return 1;
 }
 

From 91caa451fce8c98f119be9ac21960c6f7dfd1393 Mon Sep 17 00:00:00 2001
From: waynieack <wayne@razorcla.ws>
Date: Sat, 26 Aug 2017 23:07:49 -0500
Subject: [PATCH 2/2] More HTTP performance updates in json_server

---
 bin/mh             |  4 ++--
 lib/json_server.pl | 18 ++++++++----------
 2 files changed, 10 insertions(+), 12 deletions(-)

diff --git a/bin/mh b/bin/mh
index 060a57e07..e653c7c1c 100755
--- a/bin/mh
+++ b/bin/mh
@@ -2584,7 +2584,7 @@ sub check_for_socket_data_http {
                 # We must sleep here for a bit, or else Netscape sometimes
                 # says 'Document contains no data'.  Guess we don't need this anymore :)
                 #               select undef, undef, undef, .010;
-		print "http: closing socket - ". $Info{'http_socket'}->peer ." ....\n" if $Debug{http};
+		#print "http: closing socket - ". $Info{'http_socket'}->peer ." ....\n" if $Debug{http};
                 &socket_close('http');
             }
         }
@@ -6700,7 +6700,7 @@ sub sig_handler_pipe {
 sub sig_child_death {
 
     #   my $pid = wait;
-    #   print "reaped $pid" . ($? ? " with exit $?" : '');
+     # print "reaped $pid" . ($? ? " with exit $?" : '');
     # Harvest potentially more than one dead child
     use POSIX ":sys_wait_h";
     my $pid;
diff --git a/lib/json_server.pl b/lib/json_server.pl
index b04266d89..79015b8c0 100755
--- a/lib/json_server.pl
+++ b/lib/json_server.pl
@@ -501,14 +501,12 @@ sub json_get {
         # is time consuming, particularly when called numerous times.  Instead,
         # we create a lookup table one time, saving a lot of processing time.
 	$json_cache{parent_table} = build_parent_table() if ( !($json_cache{parent_table}) || $Reload );
-
         if ( $args{items} && $args{items}[0] ne "" ) {
             foreach my $name ( @{ $args{items} } ) {
 
                 #$name =~ s/\$|\%|\&|\@//g;
                 my $o = &get_object_by_name($name);
-                print_log "json: object name=$name ref=" . ref $o
-                  if $Debug{json};
+                print_log "json: object name=$name ref=" . ref $o if $Debug{json};
                 if ( my $data = &json_object_detail( $o, \%args, \%fields, $json_cache{parent_table} ) ) {
                     $json_data{objects}{$name} = $data;
                 }
@@ -522,6 +520,11 @@ sub json_get {
                     push @objects, &list_objects_by_type($_);
                 }
             }
+            elsif ( $args{parents} ) {
+                for ( @{ $args{parents} } ) {
+                    push @objects, &list_objects_by_group( $_, 1 )
+                }
+            }
             else {
                 foreach my $object_type ( list_object_types() ) {
                     push @objects, &list_objects_by_type($object_type);
@@ -534,8 +537,7 @@ sub json_get {
                 my $name = $o;
                 $name = $o->{object_name};
                 $name =~ s/\$|\%|\&|\@//g;
-                print_log "json: object name=$name ref=" . ref $o
-                  if $Debug{json};
+                print_log "json: (map) object name=$name ref=" . ref $o if $Debug{json};
                 if ( my $data = &json_object_detail( $o, \%args, \%fields, $json_cache{parent_table} ) ) {
                     $json_data{objects}{$name} = $data;
                 }
@@ -1030,16 +1032,13 @@ sub json_walk_var {
 }
 
 sub build_parent_table {
-	print_log "json: build_parent_table running";
     my @groups;
     my %parent_table;
     for my $group_name ( &list_objects_by_type('Group') ) {
         my $group = &get_object_by_name($group_name);
         $group_name =~ s/\$|\%|\&|\@//g;
-	 print_log "json: build_parent_table group: $group_name";
         unless ( defined $group ) {
-            print_log "json: build_parent_table, group_name $group_name doesn't have an object?"
-              if $Debug{json};
+            print_log "json: build_parent_table, group_name $group_name doesn't have an object?" if $Debug{json};
             next;
         }
         else {
@@ -1386,7 +1385,6 @@ sub json_table_push {
     return 0 if ( !defined $json_table{$key} );
     	
     $json_table{$key}{time} = &get_tickcount;
-    &::set_waiter_flags('push_flag',1);
     return 1;
 }