diff --git a/lib/Starman/Server.pm b/lib/Starman/Server.pm index 67d1528..40b6a77 100644 --- a/lib/Starman/Server.pm +++ b/lib/Starman/Server.pm @@ -442,7 +442,8 @@ sub _finalize_response { my(@headers, %headers); push @headers, "$protocol $status $message"; - # Switch on Transfer-Encoding: chunked if we don't know Content-Length. + # Switch on Transfer-Encoding: chunked if we don't know Content-Length + # and Transfer-Encoding: chunked is not already in effect. my $chunked; my $headers = $res->[1]; for (my $i = 0; $i < @$headers; $i += 2) { @@ -456,15 +457,12 @@ sub _finalize_response { if ( $protocol eq 'HTTP/1.1' ) { if ( !exists $headers{'content-length'} ) { if ( $status !~ /^1\d\d|[23]04$/ ) { - DEBUG && warn "[$$] Using chunked transfer-encoding to send unknown length body\n"; - push @headers, 'Transfer-Encoding: chunked'; - $chunked = 1; - } - } - elsif ( my $te = $headers{'transfer-encoding'} ) { - if ( $te eq 'chunked' ) { - DEBUG && warn "[$$] Chunked transfer-encoding set for response\n"; - $chunked = 1; + my $te = $headers{'transfer-encoding'}; + if ( !$te || $te ne 'chunked' ) { + DEBUG && warn "[$$] Using chunked transfer-encoding to send unknown length body\n"; + push @headers, 'Transfer-Encoding: chunked'; + $chunked = 1; + } } } } else { diff --git a/t/chunked_res.t b/t/chunked_res.t new file mode 100644 index 0000000..d2a85ee --- /dev/null +++ b/t/chunked_res.t @@ -0,0 +1,54 @@ +use strict; +use Plack::Test; +use HTTP::Request; +use Test::More; +use IO::Socket qw(:crlf); + +$Plack::Test::Impl = "Server"; +$ENV{PLACK_SERVER} = 'Starman'; + +my @app = ( + sub { + my $env = shift; + return sub { + my $response = shift; + my $writer = $response->([ 200, [ 'Content-Type', 'text/plain' ]]); + $writer->write("This is the data in the first chunk${CRLF}"); + $writer->write("and this is the second one${CRLF}"); + $writer->write("con"); + $writer->write("sequence"); + $writer->close; + } + }, + sub { + my $env = shift; + return sub { + my $response = shift; + my $writer = $response->([ + 200, [ 'Content-Type', 'text/plain', 'Transfer-Encoding', 'chunked' ] + ]); + $writer->write("25${CRLF}This is the data in the first chunk${CRLF}${CRLF}"); + $writer->write("1C${CRLF}and this is the second one${CRLF}${CRLF}"); + $writer->write("3${CRLF}con${CRLF}"); + $writer->write("8${CRLF}sequence${CRLF}"); + $writer->write("0${CRLF}${CRLF}"); + $writer->close; + } + }, +); + +for my $app (@app) { + test_psgi $app, sub { + my $cb = shift; + + my $req = HTTP::Request->new(GET => "http://localhost/"); + my $res = $cb->($req); + + is $res->content, + "This is the data in the first chunk\r\n" . + "and this is the second one\r\n" . + "consequence"; + }; +} + +done_testing;