Skip to content

Commit

Permalink
Merge pull request #13 from waynieack/HTTP_Updates
Browse files Browse the repository at this point in the history 
Updated more code to use HTTP1.1 with Content-Length
  • Loading branch information
@hplato
hplato authored Aug 14, 2017
2 parents fd8efdf + de6b5b2 commit e2f76ab
Show file tree
Hide file tree
Showing 5 changed files with 99 additions and 83 deletions.
9 changes: 7 additions & 2 deletions lib/ajax.pm
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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;
}
Expand All @@ -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;
}
Expand Down
129 changes: 64 additions & 65 deletions lib/http_server.pl
View file
Original file line number Diff line number Diff line change
Expand Up @@ -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() );
Expand Down Expand Up @@ -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;
}
Expand All @@ -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 ) = @_;
Expand Down Expand Up @@ -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;
Expand All @@ -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 ) = @_;

Expand All @@ -1894,35 +1890,35 @@ 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*)/;
$end = ($full_length) - $start - 1 if ( $end eq "" );

#$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
}
Expand All @@ -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;
Expand Down Expand Up @@ -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 <<eof;
HTTP/1.0 302 Moved Temporarily
Location: $url
$Cookie
eof
my ($url) = @_;
print "http_redirect Location: $url\n" if $main::Debug{http};

my $html_head = "HTTP/1.1 302 Moved Temporarily\r\n";
$html_head .= "Server: MisterHouse\r\n";
$html_head .= "Location: $url\r\n";
$html_head .= "Connection: close\r\n";
$html_head .= "Cache-Control: no-cache\r\n";
$html_head .= "\r\n";

return $html_head;
}

sub http_agent_size {
Expand Down
16 changes: 10 additions & 6 deletions lib/json_server.pl
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1273,11 +1273,7 @@ sub json_entities_encode {
}

sub json_usage {
my $html = <<eof;
HTTP/1.0 200 OK
Server: MisterHouse
Content-type: text/html
my $html = <<eof;
<html>
<head>
</head>
Expand Down Expand Up @@ -1315,8 +1311,16 @@ sub json_usage {
</body>
</html>
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 {
Expand Down
14 changes: 9 additions & 5 deletions web/bin/photos_new.pl
View file
Original file line number Diff line number Diff line change
Expand Up @@ -50,10 +50,6 @@
}
my $html = <<eof;
HTTP/1.0 200 OK
Server: MisterHouse
Content-type: text/html
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
<html>
<head>
Expand Down Expand Up @@ -84,4 +80,12 @@
</body>
</html>
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;
14 changes: 9 additions & 5 deletions web/bin/photos_slideshow.pl
View file
Original file line number Diff line number Diff line change
Expand Up @@ -83,10 +83,6 @@
$sseffect .= "width: $width });";
my $js = <<eof;
HTTP/1.0 200 OK
Server: MisterHouse
Content-type: application/x-javascript
window.addEvent('domready', function(){
var data = {
$images
Expand All @@ -95,4 +91,12 @@
});
eof
return $js;
my $html_head = "HTTP/1.1 200 OK\r\n";
$html_head .= "Server: MisterHouse\r\n";
$html_head .= "Content-type: application/x-javascript\r\n";
$html_head .= "Content-Length: " . ( length $js ) . "\r\n";
$html_head .= "Date: " . time2str(time) . "\r\n";
$html_head .= "\r\n";
return $html_head.$js;

0 comments on commit e2f76ab

Please sign in to comment.