Skip to content

Commit

Permalink
Merge pull request #728 from hplato/ia7
Browse files Browse the repository at this point in the history
ia7 v1.5.720 and HTTP 1.1, forking improvements
  • Loading branch information
hplato authored Aug 30, 2017
2 parents 92f733e + 1cb682e commit 4a815ce
Show file tree
Hide file tree
Showing 19 changed files with 592 additions and 318 deletions.
32 changes: 26 additions & 6 deletions bin/mh
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,12 +6700,16 @@ 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";
local ($!, $?);

my $pid;
do {
$pid = waitpid( -1, WNOHANG );
print "***PID MH reaped $pid" . ($? ? " with exit $?" : '') . "\n" if $Debug{fork};

} until $pid <= 0;

# $pid = waitpid(-1, &WNOHANG);
Expand Down Expand Up @@ -6813,9 +6822,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 +7765,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
55 changes: 33 additions & 22 deletions code/common/ia7_notifications.pl
Original file line number Diff line number Diff line change
Expand Up @@ -3,15 +3,15 @@
#@ IA7 v1.1 : Enables speech notifications to browsers.
#@ also includes some sample code of how to use other notifications

if ( $Startup or $Reload ) {
if ( !defined $Info{IPAddress_local} ) {
print_log "json_server.pl: \$Info{IPAddress_local} not defined. Json speech disabled";
}
else {
print_log "IA7 Speech Notifications enabled";
&Speak_parms_add_hook( \&json_speech_enable );
}
}
#if ( $Startup or $Reload ) {
# if ( !defined $Info{IPAddress_local} ) {
# print_log "json_server.pl: \$Info{IPAddress_local} not defined. Json speech disabled";
# }
# else {
# print_log "IA7 Speech Notifications enabled";
# #&Speak_parms_add_hook( \&json_speech_enable );
# }
#}

$v_ia7_test_sound = new Voice_Cmd("Test playing a sound");
$v_ia7_test_banner = new Voice_Cmd("Test [blue,green,yellow,red] Banner Notification");
Expand All @@ -29,18 +29,29 @@
&json_notification( "sound", {%data} );
}

sub json_speech_enable {
my ($parms) = @_;
push @{ $parms->{web_hook} }, \&file_ready_for_ia7;
}

sub file_ready_for_ia7 {
my (%parms) = @_;
my %data;
$data{mode} = $parms{mode};
$data{url} = "http://" . $Info{IPAddress_local} . ":" . $config_parms{http_port} . "/" . $parms{web_file};
$data{text} = $parms{raw_text};
$data{client} = $parms{requestor};
&json_notification( "speech", {%data} );
}

#sub json_speech_enable {
# my ($parms) = @_;
# push( @{ $parms->{web_hook} }, \&file_ready_for_ia7);
#}

#sub file_ready_for_ia7 {
# my (%parms) = @_;
# my %data;
# $data{mode} = $parms{mode};
# $data{url} = "http://" . $Info{IPAddress_local} . ":" . $config_parms{http_port} . "/" . $parms{web_file};
# $data{text} = $parms{raw_text};
# $data{client} = $parms{requestor};
# if (defined $Info{IPAddress_local}) {
# if ((defined $parms{forked}) and $parms{forked} ) {
# #if it's a child process we can't access the global @json_notifications array, so send a webservice call to the master process
# my $MHParent = $Info{IPAddress_local} . ":" . $config_parms{http_port};
# my $cmd = "get_url -quiet \"http://$MHParent/SUB?ia7_notify(\'speech',$data{mode},'$data{text}',$data{url})\" /dev/null";
# run "$cmd" unless (defined $config_parms{disable_json_speech} and $config_parms{disable_json_speech});
# } else {
# &json_notification( "speech", {%data} );
# }
# }
#}

4 changes: 2 additions & 2 deletions data/web/collections.json
Original file line number Diff line number Diff line change
Expand Up @@ -127,7 +127,7 @@
"name" : "Rain Rate"
},
"meta" : {
"version" : "1.3"
"version" : "1.4"
},
"4" : {
"icon" : "fa-lightbulb-o",
Expand Down Expand Up @@ -425,7 +425,7 @@
},
"120" : {
"name" : "Indoor Humidity",
"icon" : "wi-sprinkles",
"icon" : "wi-humidity",
"link" : "/ia7/#path=/rrd?now-6hour?indoor_humid"
},
"91" : {
Expand Down
2 changes: 2 additions & 0 deletions lib/Process_Item.pm
Original file line number Diff line number Diff line change
Expand Up @@ -280,6 +280,8 @@ sub start_next {
}
else {
$pid = fork;
&main::print_log("***PID Process_Item $pid (\$!=$! \$?=$?)") if $::Debug{fork};

if ($pid) {
print "Process start: parent pid=$pid type=$type cmd=$cmd\n"
if $main::Debug{process};
Expand Down
26 changes: 19 additions & 7 deletions lib/Voice_Cmd.pm
Original file line number Diff line number Diff line change
Expand Up @@ -409,19 +409,18 @@ sub set {
}
return if &main::check_for_tied_filters( $self, $state );

&main::print_log("DB Voice_Cmd : state=$state, set_by=$set_by, no_log=$no_log, respond=$respond") if $main::Debug{voice};
# Cannot do this! Respond_Target is shared by everything and its brother!
# if app passes explicit targets, then they are passed along and eventually responded to
# otherwise set_by is used

&main::print_log("DB Voice_Cmd : state=$state, set_by=$set_by, no_log=$no_log, respond=$respond") if $main::Debug{voice};

#don't process voice command if via xAP, this can cause scalability issues if all MH instances
#have mh_control.pl enabled (multiple check http server commands will run)
#if xAP voice commands need to execute, then turn on $config_parms{xap_enable_voice_cmds} = 1

return if (($set_by =~ m/^xAP/) and ((!defined $::config_parms{xap_enable_voice_cmds}) or ((defined $::config_parms{xap_enable_voice_cmds}) and ($::config_parms{xap_enable_voice_cmds} == 0))));
return if (($set_by =~ m/^xAP/) and (!(defined $::config_parms{xap_enable_voice_cmds}) and ($::config_parms{xap_enable_voice_cmds} == 0)));

&main::print_log("DB Voice_Cmd : executing $cmd") if $main::Debug{voice};

# Cannot do this! Respond_Target is shared by everything and its brother!
# if app passes explicit targets, then they are passed along and eventually responded to
# otherwise set_by is used

# $respond = $main::Respond_Target unless $respond; # Pass default target along
if ( $$self{xap_target} ) {
Expand Down Expand Up @@ -557,6 +556,7 @@ sub new {
response => $response,
confirm => $confirm,
vocab => $vocab,
link => '',
state => ''
};
&_register($self);
Expand Down Expand Up @@ -878,6 +878,18 @@ sub android_xml {
return $xml_objects;
}

#Used in v4.3 to allow IA7 to link to a page after a voice commnand is clicked
sub set_link {
my ($self,$link) = @_;
$self->{link} = $link;
}

sub get_link {
my ($self) = @_;
return $self->{link} if ($self->{link});
}


1;

=back
Expand Down
11 changes: 10 additions & 1 deletion lib/Voice_Text.pm
Original file line number Diff line number Diff line change
Expand Up @@ -332,6 +332,8 @@ sub speak_text {

if ($fork) {
my $pid = fork;
print "***PID created voice_text 1: $pid" . ($? ? " with exit $?" : '') . "\n" if $::Debug{fork};


# we are the parent
if ( $fork and $pid ) {
Expand All @@ -342,7 +344,7 @@ sub speak_text {
# Wait for server to respond that it is done
my $sock = $main::Socket_Ports{festival}{sock};
my $i;
while ( $i++ < 100 ) {
while ( $i++ < 200 ) {
print '-' if $main::Debug{voice};
select undef, undef, undef, .1;
my $nfound = &main::socket_has_data($sock);
Expand Down Expand Up @@ -376,6 +378,8 @@ sub speak_text {
my $fork = $parms{async};
if ($fork) {
my $pid = fork;
print "***PID created voice_text 2: $pid" . ($? ? " with exit $?" : '') . "\n" if $::Debug{fork};


# we are the parent
if ( $fork and $pid ) {
Expand Down Expand Up @@ -435,6 +439,8 @@ sub speak_text {
my $fork = $parms{async};
if ($fork) {
my $pid = fork;
print "***PID created voice_text 3: $pid" . ($? ? " with exit $?" : '') ."\n" if $::Debug{fork};


# we are the parnet
if ( $fork and $pid ) {
Expand Down Expand Up @@ -469,6 +475,7 @@ sub speak_text {
my $fork = $parms{async};
if ($fork) {
my $pid = fork;
print "***PID created voice_text 4: $pid" . ($? ? " with exit $?" : '') . "\n" if $::Debug{fork};

# we are the parnet
if ( $fork and $pid ) {
Expand Down Expand Up @@ -544,6 +551,7 @@ sub speak_text {
and !$parms{async}; # Must wait for to_file requests, so http requests work

my $pid = fork if $fork;
print "***PID created voice_text 5: $pid" . ($? ? " with exit $?" : '') . "\n" if ($fork and $::Debug{fork});

# $SIG{CHLD} = "IGNORE"; # eliminate zombies created by FORK() ... we do this in bin/mh
if ( $fork and $pid ) {
Expand Down Expand Up @@ -821,6 +829,7 @@ sub speak_text {

if ($webFork) {
my $pid = fork;
print "***PID created voice_text 6: $pid" . ($? ? " with exit $?" : '') . "\n" if $::Debug{fork};

# if we are the child
if ( !defined($pid) ) {
Expand Down
36 changes: 23 additions & 13 deletions lib/ajax.pm
Original file line number Diff line number Diff line change
Expand Up @@ -55,6 +55,7 @@ sub new {
${ $$self{changed} } = 0; # Flag if at least on state is changed
${ $$self{event} } = "&ChangeChecker::setWaiterToChanged ('$self')";
${ $$self{sub} } = $sub;
${ $$self{checkTime} } = 1;

return $self;
}
Expand All @@ -80,26 +81,29 @@ sub checkForUpdate {

# Sending a status code makes it easier to distinish No Content from a lost
# connection on the client end.
&::print_socket_fork( ${ $$self{waitingSocket} }, "HTTP/1.0 204 No Content\n\n" );
${ $$self{waitingSocket} }->close;
my $html_head = "HTTP/1.1 204 No Content\r\n";
$html_head .= "Server: MisterHouse\r\n";
$html_head .= "Connection: close\r\n";
$html_head .= "Date: " . ::time2str(time) . "\r\n";
$html_head .= "\r\n";
&::print_socket_fork( ${ $$self{waitingSocket} }, $html_head, 1 );
#${ $$self{waitingSocket} }->close;
return 1;
}

my $xml = eval ${ $$self{sub} };
if ($@) {
&main::print_log("checkForUpdate syntax error in sub ${$$self{sub}}\n\t$@")
if $main::Debug{ajax};
&main::print_log("checkForUpdate syntax error in sub ${$$self{sub}}\n\t$@") if $main::Debug{ajax};
return 1;
}

if ($xml) {
&main::print_log("checkForUpdate sub ${$$self{sub}} returned $xml")
if $main::Debug{ajax};
&::print_socket_fork( ${ $$self{waitingSocket} }, $xml );
&main::print_log( "Closing Socket " . ${ $$self{waitingSocket} } )
if $main::Debug{ajax};
${ $$self{waitingSocket} }->shutdown(2)
; #Changed this from close() to shutdown(2). In some cases, the parent port wasn't being closed -- ie. speech events
#&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};
#${ $$self{waitingSocket} }->shutdown(2); #Changed this from close() to shutdown(2). In some cases, the parent port wasn't being closed -- ie. speech events
${ $$self{changed} } = 1;
}
else {
Expand Down Expand Up @@ -183,15 +187,21 @@ sub addWaiter {

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 ) || $push_flag );
${ $$self{checkTime} } = $currenttime;
#&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
Loading

0 comments on commit 4a815ce

Please sign in to comment.