stas 2004/08/20 17:27:23
Modified: lib/Apache compat.pm
t/conf modperl_extra.pl
t/filter/TestFilter in_bbs_body.pm in_bbs_msg.pm
out_bbs_ctx.pm out_bbs_filebucket.pm
t/protocol/TestProtocol echo_bbs.pm
t/response/TestAPI in_out_filters.pm
Log:
bb traversal fixes, deploying $b->delete so not to create temp memory
leaks
Revision Changes Path
1.116 +3 -2 modperl-2.0/lib/Apache/compat.pm
Index: compat.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/lib/Apache/compat.pm,v
retrieving revision 1.115
retrieving revision 1.116
diff -u -u -r1.115 -r1.116
--- compat.pm 9 Aug 2004 21:42:35 -0000 1.115
+++ compat.pm 21 Aug 2004 00:27:21 -0000 1.116
@@ -487,8 +487,9 @@
do {
$r->input_filters->get_brigade($bb, Apache::MODE_READBYTES,
APR::BLOCK_READ, IOBUFSIZE);
+ while (!$bb->is_empty) {
+ my $b = $bb->first;
- for (my $b = $bb->first; $b; $b = $bb->next($b)) {
if ($b->is_eos) {
$seen_eos++;
last;
@@ -498,7 +499,7 @@
$data .= $buf;
}
- $b->remove; # optimization to reuse memory
+ $b->delete;
}
} while (!$seen_eos);
1.61 +4 -2 modperl-2.0/t/conf/modperl_extra.pl
Index: modperl_extra.pl
===================================================================
RCS file: /home/cvs/modperl-2.0/t/conf/modperl_extra.pl,v
retrieving revision 1.60
retrieving revision 1.61
diff -u -u -r1.60 -r1.61
--- modperl_extra.pl 12 Aug 2004 23:38:02 -0000 1.60
+++ modperl_extra.pl 21 Aug 2004 00:27:22 -0000 1.61
@@ -174,7 +174,9 @@
warn "read_post: bb $count\n" if $debug;
- for (my $b = $bb->first; $b; $b = $bb->next($b)) {
+ while (!$bb->is_empty) {
+ my $b = $bb->first;
+
if ($b->is_eos) {
warn "read_post: EOS bucket:\n" if $debug;
$seen_eos++;
@@ -186,7 +188,7 @@
$data .= $buf;
}
- $b->remove; # optimization to reuse memory
+ $b->delete;
}
} while (!$seen_eos);
1.10 +7 -18 modperl-2.0/t/filter/TestFilter/in_bbs_body.pm
Index: in_bbs_body.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/filter/TestFilter/in_bbs_body.pm,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -u -r1.9 -r1.10
--- in_bbs_body.pm 19 Aug 2004 04:50:18 -0000 1.9
+++ in_bbs_body.pm 21 Aug 2004 00:27:22 -0000 1.10
@@ -16,30 +16,19 @@
sub handler : FilterRequestHandler {
my($filter, $bb, $mode, $block, $readbytes) = @_;
- #warn "Called!";
- my $ba = $filter->r->connection->bucket_alloc;
+ $filter->next->get_brigade($bb, $mode, $block, $readbytes);
- my $ctx_bb = APR::Brigade->new($filter->r->pool, $ba);
+ for (my $b = $bb->first; $b; $b = $bb->next($b)) {
- $filter->next->get_brigade($ctx_bb, $mode, $block, $readbytes);
-
- while (!$ctx_bb->is_empty) {
- my $b = $ctx_bb->first;
-
- $b->remove;
-
- if ($b->is_eos) {
- #warn "EOS!!!!";
- $bb->insert_tail($b);
- last;
- }
+ last if $b->is_eos;
if ($b->read(my $data)) {
#warn"[$data]\n";
- $b = APR::Bucket->new(scalar reverse $data);
+ my $nb = APR::Bucket->new(scalar reverse $data);
+ $b->insert_before($nb);
+ $b->delete;
+ $b = $nb;
}
-
- $bb->insert_tail($b);
}
Apache::OK;
1.14 +14 -23 modperl-2.0/t/filter/TestFilter/in_bbs_msg.pm
Index: in_bbs_msg.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/filter/TestFilter/in_bbs_msg.pm,v
retrieving revision 1.13
retrieving revision 1.14
diff -u -u -r1.13 -r1.14
--- in_bbs_msg.pm 19 Aug 2004 04:50:18 -0000 1.13
+++ in_bbs_msg.pm 21 Aug 2004 00:27:22 -0000 1.14
@@ -22,36 +22,27 @@
my($filter, $bb, $mode, $block, $readbytes) = @_;
debug "FILTER CALLED";
- my $c = $filter->c;
- my $ctx_bb = APR::Brigade->new($c->pool, $c->bucket_alloc);
- $filter->next->get_brigade($ctx_bb, $mode, $block, $readbytes);
+ $filter->next->get_brigade($bb, $mode, $block, $readbytes);
- while (!$ctx_bb->is_empty) {
- my $b = $ctx_bb->first;
+ for (my $b = $bb->first; $b; $b = $bb->next($b)) {
- $b->remove;
+ last if $b->is_eos;
- if ($b->is_eos) {
- debug "EOS!!!";
- $bb->insert_tail($b);
- last;
- }
-
- $b->read(my $data);
- debug "FILTER READ:\n$data";
-
- if ($data and $data =~ s,GET $from_url,GET $to_url,) {
+ if ($b->read(my $data)) {
+ next unless $data =~ s|GET $from_url|GET $to_url|;
debug "GET line rewritten to be:\n$data";
- $b = APR::Bucket->new($data);
- # XXX: currently a bug in httpd doesn't allow to remove
- # the first connection filter. once it's fixed adjust the test
- # to test that it was invoked only once.
- # debug "removing the filter";
- # $filter->remove; # this filter is no longer needed
+ my $nb = APR::Bucket->new($data);
+ $b->insert_before($nb);
+ $b->delete;
+ $b = $nb;
}
- $bb->insert_tail($b);
+ # XXX: currently a bug in httpd doesn't allow to remove
+ # the first connection filter. once it's fixed adjust the test
+ # to test that it was invoked only once.
+ # debug "removing the filter";
+ # $filter->remove; # this filter is no longer needed
}
Apache::OK;
1.10 +17 -3 modperl-2.0/t/filter/TestFilter/out_bbs_ctx.pm
Index: out_bbs_ctx.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/filter/TestFilter/out_bbs_ctx.pm,v
retrieving revision 1.9
retrieving revision 1.10
diff -u -u -r1.9 -r1.10
--- out_bbs_ctx.pm 19 Aug 2004 04:50:18 -0000 1.9
+++ out_bbs_ctx.pm 21 Aug 2004 00:27:22 -0000 1.10
@@ -11,9 +11,12 @@
use APR::Brigade ();
use APR::Bucket ();
+use APR::BucketType ();
use base qw(Apache::Filter);
+use Apache::TestTrace;
+
use Apache::Const -compile => qw(OK M_POST);
use APR::Const -compile => ':common';
@@ -22,6 +25,8 @@
sub handler {
my($filter, $bb) = @_;
+ debug "filter got called";
+
my $c = $filter->c;
my $bb_ctx = APR::Brigade->new($c->pool, $c->bucket_alloc);
@@ -31,19 +36,22 @@
my $data = exists $ctx->{data} ? $ctx->{data} : '';
while (my $b = $bb->first) {
- $b->remove;
if ($b->is_eos) {
+ debug "got EOS";
# flush the remainings and send a stats signature
$bb_ctx->insert_tail(APR::Bucket->new("$data\n")) if $data;
my $sig = join "\n", "received $ctx->{blocks} complete blocks",
"filter invoked $ctx->{invoked} times\n";
$bb_ctx->insert_tail(APR::Bucket->new($sig));
+ $b->remove;
$bb_ctx->insert_tail($b);
last;
}
if ($b->read(my $bdata)) {
+ debug "got data";
+ $b->delete;
$data .= $bdata;
my $len = length $data;
@@ -55,10 +63,16 @@
$ctx->{blocks} += $blocks;
}
if ($blocks) {
- $b = APR::Bucket->new("#" x $blocks);
- $bb_ctx->insert_tail($b);
+ my $nb = APR::Bucket->new("#" x $blocks);
+ $bb_ctx->insert_tail($nb);
}
}
+ else {
+ debug "got bucket with no data: type: " . $b->type->name;
+ $b->remove;
+ $bb_ctx->insert_tail($b);
+ }
+
}
$ctx->{data} = $data;
1.5 +5 -13 modperl-2.0/t/filter/TestFilter/out_bbs_filebucket.pm
Index: out_bbs_filebucket.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/filter/TestFilter/out_bbs_filebucket.pm,v
retrieving revision 1.4
retrieving revision 1.5
diff -u -u -r1.4 -r1.5
--- out_bbs_filebucket.pm 19 Aug 2004 04:50:18 -0000 1.4
+++ out_bbs_filebucket.pm 21 Aug 2004 00:27:22 -0000 1.5
@@ -23,9 +23,6 @@
sub handler {
my($filter, $bb) = @_;
- my $c = $filter->c;
- my $bb_ctx = APR::Brigade->new($c->pool, $c->bucket_alloc);
-
debug "FILTER INVOKED";
my $cnt = 0;
@@ -34,22 +31,17 @@
$cnt++;
debug "reading bucket #$cnt";
- if ($b->is_eos) {
- $b->remove;
- $bb_ctx->insert_tail($b);
- last;
- }
+ last if $b->is_eos;
if (my $len = $b->read(my $data)) {
my $nb = APR::Bucket->new(uc $data);
- $bb_ctx->insert_tail($nb);
+ $b->insert_before($nb);
+ $b->delete;
+ $b = $nb;
}
}
- my $rv = $filter->next->pass_brigade($bb_ctx);
- return $rv unless $rv == APR::SUCCESS;
-
- return Apache::OK;
+ return $filter->next->pass_brigade($bb);
}
sub response {
1.8 +21 -18 modperl-2.0/t/protocol/TestProtocol/echo_bbs.pm
Index: echo_bbs.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/protocol/TestProtocol/echo_bbs.pm,v
retrieving revision 1.7
retrieving revision 1.8
diff -u -u -r1.7 -r1.8
--- echo_bbs.pm 19 Aug 2004 04:50:18 -0000 1.7
+++ echo_bbs.pm 21 Aug 2004 00:27:22 -0000 1.8
@@ -4,6 +4,9 @@
# manipulations on the buckets inside the connection handler, rather
# then using filter
+# it also demonstrates how to use a single bucket bridade to do all
+# the manipulation
+
use strict;
use warnings FATAL => 'all';
@@ -13,6 +16,8 @@
use APR::Brigade ();
use APR::Error ();
+use Apache::TestTrace;
+
use Apache::Const -compile => qw(OK MODE_GETLINE);
use APR::Const -compile => qw(SUCCESS EOF SO_NONBLOCK);
@@ -23,38 +28,36 @@
# the socket to a blocking IO mode
$c->client_socket->opt_set(APR::SO_NONBLOCK, 0);
- my $bb_in = APR::Brigade->new($c->pool, $c->bucket_alloc);
- my $bb_out = APR::Brigade->new($c->pool, $c->bucket_alloc);
+ my $bb = APR::Brigade->new($c->pool, $c->bucket_alloc);
while (1) {
- my $rc = $c->input_filters->get_brigade($bb_in,
- Apache::MODE_GETLINE);
+ debug "asking new line";
+ my $rc = $c->input_filters->get_brigade($bb, Apache::MODE_GETLINE);
last if $rc == APR::EOF;
die APR::Error::strerror($rc) unless $rc == APR::SUCCESS;
- while (!$bb_in->is_empty) {
- my $bucket = $bb_in->first;
+ for (my $b = $bb->first; $b; $b = $bb->next($b)) {
- $bucket->remove;
+ last if $b->is_eos;
- if ($bucket->is_eos) {
- $bb_out->insert_tail($bucket);
- last;
- }
+ debug "processing new line";
- if ($bucket->read(my $data)) {
+ if ($b->read(my $data)) {
last if $data =~ /^[\r\n]+$/;
- $bucket = APR::Bucket->new(uc $data);
+ my $nb = APR::Bucket->new(uc $data);
+ # head->...->$nb->$b ->...->tail
+ # XXX: the next 3 lines could be replaced with a
+ # wrapper function $b->replace($nb);
+ $b->insert_before($nb);
+ $b->delete;
+ $b = $nb;
}
-
- $bb_out->insert_tail($bucket);
}
- $c->output_filters->fflush($bb_out);
+ $c->output_filters->fflush($bb);
}
- $bb_in->destroy;
- $bb_out->destroy;
+ $bb->destroy;
Apache::OK;
}
1.3 +1 -5 modperl-2.0/t/response/TestAPI/in_out_filters.pm
Index: in_out_filters.pm
===================================================================
RCS file: /home/cvs/modperl-2.0/t/response/TestAPI/in_out_filters.pm,v
retrieving revision 1.2
retrieving revision 1.3
diff -u -u -r1.2 -r1.3
--- in_out_filters.pm 24 Jul 2004 07:27:31 -0000 1.2
+++ in_out_filters.pm 21 Aug 2004 00:27:22 -0000 1.3
@@ -46,7 +46,6 @@
sub read_request_body {
my $r = shift;
- my $debug = shift || 0;
my $bb = APR::Brigade->new($r->pool,
$r->connection->bucket_alloc);
@@ -59,21 +58,18 @@
APR::BLOCK_READ, IOBUFSIZE);
$count++;
- warn "read_post: bb $count\n" if $debug;
for (my $b = $bb->first; $b; $b = $bb->next($b)) {
if ($b->is_eos) {
- warn "read_post: EOS bucket:\n" if $debug;
$seen_eos++;
last;
}
if ($b->read(my $buf)) {
- warn "read_post: DATA bucket: [$buf]\n" if $debug;
$data .= $buf;
}
- $b->remove; # optimization to reuse memory
+ $b->delete;
}
} while (!$seen_eos);
