Skip to content

Commit

Permalink
Merge pull request #15 from waynieack/HTTP_Updates
Browse files Browse the repository at this point in the history 
Http updates
  • Loading branch information
@hplato
hplato authored Aug 27, 2017
2 parents 7730a04 + 91caa45 commit 9534c87
Show file tree
Hide file tree
Showing 4 changed files with 55 additions and 30 deletions.
28 changes: 22 additions & 6 deletions bin/mh
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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) {
Expand All @@ -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');
}
}
Expand Down Expand Up @@ -6695,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;
Expand Down Expand Up @@ -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 ) );

Expand Down Expand Up @@ -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
Expand Down
9 changes: 6 additions & 3 deletions lib/ajax.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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};
Expand Down Expand Up @@ -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 {
Expand Down
23 changes: 13 additions & 10 deletions lib/http_server.pl
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand All @@ -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;
Expand Down Expand Up @@ -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;
Expand Down Expand Up @@ -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
}
}

Expand Down Expand Up @@ -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)
Expand Down
25 changes: 14 additions & 11 deletions lib/json_server.pl
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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 {
Expand Down Expand Up @@ -499,16 +500,14 @@ 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} } ) {

#$name =~ s/\$|\%|\&|\@//g;
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 ) ) {
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;
}
}
Expand All @@ -521,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);
Expand All @@ -533,9 +537,8 @@ 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};
if ( my $data = &json_object_detail( $o, \%args, \%fields, $parent_table ) ) {
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;
}
}
Expand Down Expand Up @@ -643,6 +646,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
Expand Down Expand Up @@ -1030,8 +1034,7 @@ sub build_parent_table {
my $group = &get_object_by_name($group_name);
$group_name =~ s/\$|\%|\&|\@//g;
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 {
Expand Down Expand Up @@ -1382,7 +1385,7 @@ sub json_table_push {
my ($key) = @_;

return 0 if ( !defined $json_table{$key} );

$json_table{$key}{time} = &get_tickcount;
return 1;
}
Expand Down

0 comments on commit 9534c87

Please sign in to comment.