Index: trunk/t/52-chunked-upload.t =================================================================== --- trunk/t/52-chunked-upload.t (revision 617) +++ trunk/t/52-chunked-upload.t (revision 617) @@ -0,0 +1,186 @@ +#!/usr/bin/perl + +use strict; +use Perlbal::Test; +use Perlbal::Test::WebServer; +use Perlbal::Test::WebClient; +use IO::Socket::INET; +use Test::More 'no_plan'; + +# setup webserver +my $web_port = start_webserver(); +ok($web_port, 'webserver started'); + +# setup perlbal +my $port = new_port(); +my $dir = tempdir(); + +my $conf = qq{ +SERVER aio_mode = none + +CREATE POOL a +POOL a ADD 127.0.0.1:$web_port + +CREATE SERVICE test +SET role = reverse_proxy +SET pool = a +SET connect_ahead = 0 +SET listen = 127.0.0.1:$port +SET persist_client = 1 +SET buffer_uploads_path = $dir +SET buffer_uploads = 1 +ENABLE test +}; + +my $msock = start_server($conf); +ok($msock, 'perlbal started'); + +ok(! buffer_file_exists(), "no files in buffer directory"); + +# setup data +my $data = 'x' x 1_000_000; +my ($curpos, $clen) = (0, 0); + +my $req; + +# disable all of it +request("buffer_off", 500_000, + "write:500", + "write:5", + "write:5", + "write:5", + "sleep:0.25", + "exists", + "write:100000", + "write:60000", + "write:1000", + "finish", + sub { + my ($res) = @_; + my $cont = $res->content; + like($cont, qr/length = 500000/, "backend got right content-length"); + }, + "empty"); + +sub buffer_file_exists { + opendir DIR, $dir + or die "can't open dir\n"; + foreach (readdir(DIR)) { + next if /^\./; + return 1; + } + return 0; +} + +# cmds can be: +# write: writes bytes +# sleep: sleeps seconds, may be fractional +# finish (sends any final writes and/or reads response) +# close close socket +# sub {} coderef to run. gets passed response object +# no-reason response has no reason +# reason: did buffering for either "size", "rate", or "time" +# empty No files in temp buffer location +# exists Yes, a temporary file exists +sub request { + my $testname = shift; + my $len = shift || 0; + my @cmds = @_; + + my $curpos = 0; + my $remain = $len; + + my $hdr = "POST /status HTTP/1.0\r\nTransfer-Encoding: chunked\r\nExpect: 100-continue\r\n\r\n"; + my $sock = IO::Socket::INET->new( PeerAddr => "127.0.0.1:$port" ) + or return undef; + my $rv = syswrite($sock, $hdr); + die unless $rv == length($hdr); + + # wanting HTTP/1.1 100 Continue\r\n...\r\n lines + { + my $contline = <$sock>; + die "didn't get 100 Continue line, got: $contline" + unless $contline =~ m!^HTTP/1.1 100!; + my $gotempty = 0; + while (defined(my $line = <$sock>)) { + if ($line eq "\r\n") { + $gotempty = 1; + last; + } + } + die "didn't get empty line after 100 Continue" unless $gotempty; + } + + my $res = undef; # no response yet + + foreach my $cmd (@cmds) { + my $writelen; + + if ($cmd =~ /^write:([\d_]+)/) { + $writelen = $1; + $writelen =~ s/_//g; + } elsif ($cmd =~ /^(\d+)/) { + $writelen = $1; + } elsif ($cmd eq "finish") { + $writelen = $remain; + } + + if ($cmd =~ /^sleep:([\d\.]+)/) { + select undef, undef, undef, $1; + next; + } + + if ($cmd eq "close") { + close($sock); + next; + } + + if ($cmd eq "exists") { + ok(buffer_file_exists(), "$testname: buffer file exists"); + next; + } + + if ($cmd eq "empty") { + ok(! buffer_file_exists(), "$testname: no file"); + next; + } + + if ($writelen) { + die "Too long" if $writelen > $remain; + my $buf = "x" x $writelen; + $buf = sprintf("%x\r\n", $writelen) . $buf . "\r\n"; + $remain -= $writelen; + if ($remain == 0) { + # one \r\n for chunk ending, one for chunked-body ending, + # after (our empty) trailer... + $buf .= "0\r\n\r\n"; + } + my $bufsize = length($buf); + my $off = 0; + while ($off < $bufsize) { + my $rv = syswrite($sock, $buf, $bufsize-$off, $off); + die "Error writing: $!" unless defined $rv; + die "Got rv=0 from syswrite" unless $rv; + $off += $rv; + } + + next unless $cmd eq "finish"; + } + + if ($cmd eq "finish") { + $res = resp_from_sock($sock); + my $clen = $res ? $res->header('Content-Length') : 0; + ok($res && length($res->content) == $clen, "$testname: good response"); + next; + } + + if (ref $cmd eq "CODE") { + $cmd->($res, $testname); + next; + } + + die "Invalid command: $cmd\n"; + } +} + +1; Index: trunk/doc/http-versions.txt =================================================================== --- trunk/doc/http-versions.txt (revision 617) +++ trunk/doc/http-versions.txt (revision 617) @@ -0,0 +1,23 @@ +Perlbal for the most part only speaks HTTP/1.0 both to clients and to +backend webservers. It happily takes requests advertising HTTP/1.1 +and downgrading them to HTTP/1.0 when speaking to backend serves. + +It knows all about persistent connections (in both 1.0 and 1.1) and +will reply with HTTP/1.0 Connection: keep-alive the request was only +implicitly keep-alive with HTTP/1.1. etc, etc. + +Perlbal is now also starting to speak more of 1.1. For instance, +Perlbal does support receiving transfer-encoding "chunked" requests +from clients (a feature of HTTP/1.1), will send a "100 Continue" in +response to "Expect: 100-continue", and will parse the chunked +requests, writing the request-of-unknown-length to disk (only if +buffered_uploads is enabled), and then will send an HTTP/1.0 request +to the backends, with the actual Content-Length (now known) filled in. + +When more of 1.1 is supported, it will become an option, and later +become the default. However, after several years of usage, there just +hasn't been that much of a reason. The chunked requests (common from +mobile phones uploading large images) has been the most annoying +shortcoming but now that it's solved, it's questionable whether or not +more of HTTP/1.1 will be supported. + Index: trunk/MANIFEST =================================================================== --- trunk/MANIFEST (revision 584) +++ trunk/MANIFEST (revision 617) @@ -7,4 +7,5 @@ lib/Perlbal/BackendHTTP.pm lib/Perlbal/Cache.pm +lib/Perlbal/ChunkedUploadState.pm lib/Perlbal/ClientHTTP.pm lib/Perlbal/ClientHTTPBase.pm @@ -33,4 +34,5 @@ META.yml Module meta-data (added by MakeMaker) devtools/gendocs.pl +doc/http-versions.txt doc/config-guide.txt doc/service-parameters.txt @@ -59,3 +61,4 @@ t/45-buffereduploads.t t/50-plugins.t +t/52-chunked-upload.t Index: trunk/META.yml =================================================================== --- trunk/META.yml (revision 607) +++ trunk/META.yml (revision 617) @@ -2,5 +2,5 @@ #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: Perlbal -version: 1.52 +version: 1.53 version_from: lib/Perlbal.pm installdirs: site Index: trunk/lib/Perlbal/ClientProxy.pm =================================================================== --- trunk/lib/Perlbal/ClientProxy.pm (revision 612) +++ trunk/lib/Perlbal/ClientProxy.pm (revision 617) @@ -10,4 +10,6 @@ use base "Perlbal::ClientHTTPBase"; no warnings qw(deprecated); + +use Perlbal::ChunkedUploadState; use fields ( @@ -36,4 +38,7 @@ 'backend_stalled', # boolean: if backend has shut off its reads because we're too slow. 'unread_data_waiting', # boolean: if we shut off reads while we know data is yet to be read from client + 'chunked_upload_state', # bool/obj: if processing a chunked upload, Perlbal::ChunkedUploadState object, else undef + 'request_body_length', # integer: request's body length, either as-declared, + # or calculated after chunked upload is complete # for perlbal sending out UDP packets related to upload status (for xmlhttprequest upload bar) @@ -99,4 +104,6 @@ $self->{buoutpos} = 0; $self->{bureason} = undef; + $self->{chunked_upload_state} = undef; + $self->{request_body_length} = undef; $self->{reproxy_uris} = undef; @@ -467,4 +474,6 @@ $self->{bureason} = undef; $self->{upload_session} = undef; + $self->{chunked_upload_state} = undef; + $self->{request_body_length} = undef; return 1; } @@ -569,4 +578,16 @@ print " disabling reads.\n" if Perlbal::DEBUG >= 3; $self->watch_read(0); + return; + } + + # deal with chunked uploads + if (my $cus = $self->{chunked_upload_state}) { + $cus->on_readable($self); + + # if we got more than 1MB not flushed to disk, + # stop reading for a bit until disk catches up + if ($self->{read_ahead} > 1024*1024) { + $self->watch_read(0); + } return; } @@ -713,9 +734,15 @@ return if $svc->run_hook('start_http_request', $self); - # if defined we're waiting on some amount of data. also, we have to - # subtract out read_size, which is the amount of data that was - # extra in the packet with the header that's part of the body. - $self->{content_length_remain} = $req_hd->content_length; - $self->{unread_data_waiting} = 1 if $self->{content_length_remain}; + if ($self->handle_chunked_upload) { + # handled in method. + } else { + # if defined we're waiting on some amount of data. also, we have to + # subtract out read_size, which is the amount of data that was + # extra in the packet with the header that's part of the body. + $self->{request_body_length} = + $self->{content_length_remain} = + $req_hd->content_length; + $self->{unread_data_waiting} = 1 if $self->{content_length_remain}; + } # upload-tracking stuff. both starting a new upload track session, @@ -729,5 +756,10 @@ # either start buffering some of the request to memory, or # immediately request a backend connection. - if ($self->{content_length_remain} && $self->{service}->{buffer_backend_connect}) { + if ($self->{chunked_upload_state}) { + $self->{request_body_length} = 0; + $self->{is_buffering} = 1; + $self->{bureason} = 'chunked'; + $self->buffered_upload_update; + } elsif ($self->{content_length_remain} && $self->{service}->{buffer_backend_connect}) { # the deeper path $self->start_buffering_request; @@ -741,4 +773,42 @@ $self->request_backend; } +} + +sub handle_chunked_upload { + my Perlbal::ClientProxy $self = shift; + my $req_hd = $self->{req_headers}; + my $te = $req_hd->header("Transfer-Encoding"); + return unless $te && $te eq "chunked"; + return unless $self->{service}->{buffer_uploads}; + + $req_hd->header("Transfer-Encoding", undef); # remove it (won't go to backend) + + # TODO: return false if we don't have buffered upload dir configured + my $eh = $req_hd->header("Expect"); + if ($eh && $eh =~ /\b100-continue\b/) { + $self->write(\ "HTTP/1.1 100 Continue\r\n\r\n"); + $req_hd->header("Expect", undef); # remove it (won't go to backend) + } + + my $args = { + on_new_chunk => sub { + my $cref = shift; + my $len = length($$cref); + push @{$self->{read_buf}}, $cref; + $self->{read_ahead} += $len; + $self->{request_body_length} += $len; + # TODO: if too large, disconnect? + $self->buffered_upload_update; + }, + on_disconnect => sub { + $self->client_disconnected; + }, + on_zero_chunk => sub { + $self->send_buffered_upload; + }, + }; + + $self->{chunked_upload_state} = Perlbal::ChunkedUploadState->new(%$args); + return 1; } @@ -915,4 +985,11 @@ # make sure our buoutpos is the same as the content length... + return if $self->{is_writing}; + + # set the content-length that goes to the backend... + if ($self->{chunked_upload_state}) { + $self->{req_headers}->header("Content-Length", $self->{request_body_length}); + } + my $clen = $self->{req_headers}->content_length; if ($clen != $self->{buoutpos}) { @@ -935,5 +1012,6 @@ # now send the data - my $clen = $self->{req_headers}->content_length; + my $clen = $self->{request_body_length}; + my $sent = Perlbal::Socket::sendfile($be->{fd}, fileno($self->{bufh}), $clen - $self->{buoutpos}); if ($sent < 0) { @@ -1017,6 +1095,21 @@ } + # if we're processing a chunked upload, ... + if ($self->{chunked_upload_state}) { + # turn reads back on, if we haven't hit the end yet. + if ($self->{unread_data_waiting} && $self->{read_ahead} < 1024*1024) { + $self->watch_read(1); + $self->{unread_data_waiting} = 0; + } + + if ($self->{read_ahead} == 0 && $self->{chunked_upload_state}->hit_zero_chunk) { + $self->watch_read(0); + $self->send_buffered_upload; + return; + } + } + # if we're done (no clr and no read ahead!) then send it - if ($self->{read_ahead} <= 0 && $self->{content_length_remain} <= 0) { + elsif ($self->{read_ahead} <= 0 && $self->{content_length_remain} <= 0) { $self->send_buffered_upload; return; Index: trunk/lib/Perlbal/ChunkedUploadState.pm =================================================================== --- trunk/lib/Perlbal/ChunkedUploadState.pm (revision 617) +++ trunk/lib/Perlbal/ChunkedUploadState.pm (revision 617) @@ -0,0 +1,64 @@ +package Perlbal::ChunkedUploadState; +use strict; + +sub new { + my ($pkg, %args) = @_; + my $self = bless { + 'rawbuf' => '', + 'bytes_remain' => 0, # remaining in chunk (ignoring final 2 byte CRLF) + }, $pkg; + foreach my $k (qw(on_new_chunk on_disconnect on_zero_chunk)) { + $self->{$k} = (delete $args{$k}) || sub {}; + } + die "bogus args" if %args; + return $self; +} + +sub on_readable { + my ($self, $ds) = @_; + my $rbuf = $ds->read(131072); + unless (defined $rbuf) { + $self->{on_disconnect}->(); + return; + } + + $self->{buf} .= $$rbuf; + + while ($self->drive_machine) {} +} + +# returns 1 if progress was made parsing buffer +sub drive_machine { + my $self = shift; + + my $buflen = length($self->{buf}); + return 0 unless $buflen; + + if (my $br = $self->{bytes_remain}) { + my $extract = $buflen > $br ? $br : $buflen; + my $ch = substr($self->{buf}, 0, $extract, ''); + $self->{bytes_remain} -= $extract; + die "assert" if $self->{bytes_remain} < 0; + $self->{on_new_chunk}->(\$ch); + return 1; + } + + return 0 unless $self->{buf} =~ s/^(?:\r\n)?([0-9a-fA-F]+)(?:;.*)?\r\n//; + $self->{bytes_remain} = hex($1); + + if ($self->{bytes_remain} == 0) { + # FIXME: new state machine state for trailer parsing/discarding. + # (before we do on_zero_chunk). for now, though, just assume + # no trailers and throw away the extra post-trailer \r\n that + # is probably in this packet. hacky. + $self->{buf} =~ s/^\r\n//; + $self->{hit_zero} = 1; + $self->{on_zero_chunk}->(); + return 0; + } + return 1; +} + +sub hit_zero_chunk { $_[0]{hit_zero} } + +1; Index: trunk/CHANGES =================================================================== --- trunk/CHANGES (revision 613) +++ trunk/CHANGES (revision 617) @@ -1,2 +1,7 @@ + -- supported for "Transfer-Encoding: chunked" requests (HTTP/1.1 feature) + as well as the "Expect: 100-continue", which generally accompany + chunked requests. requires "buffered_uploads" be enabled. see + doc/http-versions.txt for details. + 1.53: 2006-12-05