From de6b5b28026152d42c05ba80f56ac7dd3140d82a Mon Sep 17 00:00:00 2001 From: waynieack Date: Sun, 13 Aug 2017 03:48:22 -0500 Subject: [PATCH] Updated more code to use HTTP1.1 with Content-Length --- lib/ajax.pm | 9 ++- lib/http_server.pl | 129 ++++++++++++++++++------------------ lib/json_server.pl | 16 +++-- web/bin/photos_new.pl | 14 ++-- web/bin/photos_slideshow.pl | 14 ++-- 5 files changed, 99 insertions(+), 83 deletions(-) diff --git a/lib/ajax.pm b/lib/ajax.pm index a60de0ac4..d4df68f4c 100644 --- a/lib/ajax.pm +++ b/lib/ajax.pm @@ -80,7 +80,11 @@ 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" ); + my $html_head = "HTTP/1.1 204 No Content\r\n"; + $html_head .= "Server: MisterHouse\r\n"; + $html_head .= "Date: " . ::time2str(time) . "\r\n"; + $html_head .= "\r\n"; + &::print_socket_fork( ${ $$self{waitingSocket} }, $html_head ); ${ $$self{waitingSocket} }->close; return 1; } @@ -94,7 +98,8 @@ sub checkForUpdate { 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}; + # 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; } diff --git a/lib/http_server.pl b/lib/http_server.pl index 25bb7d740..f9a9b6f89 100644 --- a/lib/http_server.pl +++ b/lib/http_server.pl @@ -531,7 +531,7 @@ sub http_process_request { } # See if the request was for a file - if ( &test_for_file( $socket, $get_req, $get_arg ) ) { + if ( &test_for_file( $socket, $get_req, $get_arg ) ) { } elsif ( $get_req =~ /^\/JSON/i ) { &print_socket_fork( $socket, json() ); @@ -934,6 +934,8 @@ sub test_for_file { return $html; } else { + print "http: Test_for_file printing\n"; + $html = AddContentLength($html); &print_socket_fork( $socket, $html ); return 1; } @@ -943,6 +945,26 @@ sub test_for_file { } } +sub AddContentLength { + my ($html) = @_; + my $original_html = $html; + my $html_head; + if ( ($html =~ /HTTP\/1\.1 200 OK/) and !($html =~ /Content-Length:/) ) { + print "http: header match!\n"; + unless ($html =~ s/^HTTP.+?^\r\n//smi) { return $original_html } + print "http: header striped\n"; + + 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"; + return $original_html; + } else { + return $original_html; + } +} + # Check for illicit or password protected dirs sub test_file_req { my ( $socket, $get_req, $http_dir ) = @_; @@ -1810,45 +1832,14 @@ sub shtml_include { return $html; } + sub html_cgi { my ( $socket, $code, $arg ) = @_; my $html; - # Need to redirect print/printf from STDOUT to $socket - - # Method 1. Works except on Win95/98 - $config_parms{http_cgi_method} = 1 unless $config_parms{http_cgi_method}; - if ( $config_parms{http_cgi_method} == 1 ) { - open OLD_HANDLE, ">&STDOUT" - or print "\nhttp .pl error: can not backup STDOUT: $!\n"; - if ( my $fileno = $socket->fileno() ) { - print "http: cgi redirecting socket fn=$fileno s=$socket\n" - if $main::Debug{http}; - - # This is the step that fails on win98 :( - open STDOUT, ">&$fileno" - or warn "http .pl error: Can not redirect STDOUT to $fileno: $!\n"; - } - } - - # Method 2. If CGI is used (e.g. organizer scripts), this - # gives this error on eval: Undefined subroutine CGI::delete - else { - - package Override_print; - sub TIEHANDLE { bless $_[1], $_[0]; } - sub PRINT { my $coderef = shift; $coderef->(@_); } - sub PRINTF { my $coderef = shift; $coderef->(@_); } - - # sub DELETE { } - sub define_print (&) { tie( *STDOUT, "Override_print", @_ ); } - sub undefine_print (&) { untie(*STDOUT); } - - package Main; - Override_print::define_print { $html .= shift }; - } - - print "HTTP/1.0 200 OK\nServer: MisterHouse\nCache-Control: no-cache\n"; + open(my $outputFH, '>', \$html) or print "\nhttp Error: opening file handle in html_cgi sub $!\n"; + my $oldFH = select $outputFH; + # Setup up vars so pgms like CGI.pm work ok $arg =~ s/&&/&/g; @@ -1859,21 +1850,26 @@ sub html_cgi { eval '&CGI::initialize_globals'; # Need this or else CGI.pm global vars are not reset local $^W = 0; # Avoid redefined sub msgs eval $code; + select $oldFH; + close $outputFH; + my $extraheaders; + if ($html =~ s/(^.+?)\n\n//) { $extraheaders = $1 } + elsif ($html =~ s/(^.+?)\r\n//) { $extraheaders = $1 } + print "Error in http cgi eval: $@" if $@; - if ( $config_parms{http_cgi_method} == 1 ) { - $socket->close(); - open STDOUT, ">&OLD_HANDLE" - or print "\nhttp .pl error: can not redir STDIN to orig value: $!\n"; - close OLD_HANDLE; - } - else { - Override_print::undefine_print { }; - print $socket $html; - $socket->close(); - } + my $html_head = "HTTP/1.1 200 OK\r\n"; + $html_head .= "Server: MisterHouse\r\n"; + $html_head .= "Cache-Control: no-cache\r\n"; + $html_head .= "Content-Length: " . ( length $html ) . "\r\n"; + $html_head .= $extraheaders."\r\n" if $extraheaders; + $html_head .= "Date: " . time2str(time) . "\r\n"; + $html_head .= "\r\n"; + + &::print_socket_fork($socket,$html_head.$html); } + sub mime_header { my ( $file_or_type, $cache, $length, $range, $full_length ) = @_; @@ -1894,18 +1890,18 @@ sub mime_header { # print "dbx2 m=$mime f=$file_or_type\n"; my $code = "HTTP/1.1 200 OK"; $code = "HTTP/1.1 206 Partial Content" if $range; - my $header = "$code\nServer: MisterHouse\nContent-Type: $mime\n"; + my $header = "$code\r\nServer: MisterHouse\r\nContent-Type: $mime\r\n"; # $header .= ($cache) ? "Cache-Control: max-age=1000000\n" : "Cache-Control: no-cache\n"; if ($cache) { - $header .= "Last-Modified: $date\n"; + $header .= "Last-Modified: $date\r\n"; } else { - $header .= "Cache-Control: no-cache\n"; + $header .= "Cache-Control: no-cache\r\n"; } # Allow for a length header, as this allows for faster 'persistant' connections - $header .= "Content-Length: $length\n" if $length; + $header .= "Content-Length: $length\r\n" if $length; #(my $range_bytes) = $range =~ /bytes=(.*)/; my ( $start, $end ) = $range =~ /bytes=(\d*)-(\d*)/; @@ -1913,16 +1909,16 @@ sub mime_header { #$header .= "Content-Range: bytes " . $range_bytes . "/" . $full_length . "\n" if $range_bytes; #print "http: Server responds: bytes " . $range_bytes . "/" . $full_length . "\n" if $range_bytes; - $header .= "Content-Range: bytes " . $start . "-" . $end . "/" . $full_length . "\n" + $header .= "Content-Range: bytes " . $start . "-" . $end . "/" . $full_length . "\r\n" if $range; - print "http: Server responds: HTTP/1.1 206; bytes " . $start . "-" . $end . "/" . $full_length . "\n" + print "http: Server responds: HTTP/1.1 206; bytes " . $start . "-" . $end . "/" . $full_length . "\r\n" if $range; - $header .= "Accept-Ranges: bytes\n"; + $header .= "Accept-Ranges: bytes\r\n"; print "returned header = $header\n" if ( $main::Debug{http} ); - return $header . "\n"; + return $header . "\r\n"; #Expires: Mon, 01 Jul 2002 08:00:00 GMT } @@ -1938,7 +1934,6 @@ sub html_alias { sub html_no_response { my $html_head = "HTTP/1.1 204 No Content\r\n"; $html_head .= "Server: MisterHouse\r\n"; - $html_head .= "Content-type: text/html\r\n"; $html_head .= "Date: " . time2str(time) . "\r\n"; $html_head .= "\r\n"; return $html_head; @@ -2017,21 +2012,25 @@ sub html_page { $html_head .= "Content-Length: " . ( length $html ) . "\r\n"; $html_head .= "Date: " . time2str(time) . "\r\n"; $html_head .= "Cache-Control: no-cache\r\n"; - $html_head .= $Cookie . "\n\r" if $Cookie; - $html_head .= $frame . "\n\r" if $frame; + $html_head .= $Cookie . "\r\n" if $Cookie; + $html_head .= $frame . "\r\n" if $frame; $html_head .= "\r\n"; return $html_head.$html; } sub http_redirect { - my ($url) = @_; - print "http_redirect Location: $url\n" if $main::Debug{http}; - return < @@ -1315,8 +1311,16 @@ sub json_usage { eof + my $html_head = "HTTP/1.1 200 OK\r\n"; + $html_head .= "Server: MisterHouse\r\n"; + $html_head .= "Content-type: application/json\r\n"; + $html_head .= "Content-Encoding: gzip\r\n"; + $html_head .= "Content-Length: " . ( length $html ) . "\r\n"; + $html_head .= "Date: " . time2str(time) . "\r\n"; + $html_head .= "\r\n"; + - return $html; + return $html_head.$html; } sub json_table_create { diff --git a/web/bin/photos_new.pl b/web/bin/photos_new.pl index a3dff6755..f926babf9 100644 --- a/web/bin/photos_new.pl +++ b/web/bin/photos_new.pl @@ -50,10 +50,6 @@ } my $html = < @@ -84,4 +80,12 @@ eof -return $html; + +my $html_head = "HTTP/1.1 200 OK\r\n"; +$html_head .= "Server: MisterHouse\r\n"; +$html_head .= "Content-type: text/html\r\n"; +$html_head .= "Content-Length: " . ( length $html ) . "\r\n"; +$html_head .= "Date: " . time2str(time) . "\r\n"; +$html_head .= "\r\n"; + +return $html_head.$html; diff --git a/web/bin/photos_slideshow.pl b/web/bin/photos_slideshow.pl index 4e691d9ac..1fb683956 100644 --- a/web/bin/photos_slideshow.pl +++ b/web/bin/photos_slideshow.pl @@ -83,10 +83,6 @@ $sseffect .= "width: $width });"; my $js = <