That should be pretty trivial to accomplish.
To answer your question of passing data: use notes:
$filter->r->note->set(transform => 1);
if you work with the connection level filter you will need to use:
$filter->c->note->set(transform => 1);
though remember that this note will be seen through the connection, i.e. for all requests coming over the same connection.
However I believe there is a much simpler solution:
add a connection level filter similar to this one: http://perl.apache.org/docs/2.0/user/handlers/filters.html#Con
nection_Input_Filters
rewrite the request (URI) line to strip your magic argument and add a
new header, like:
X-Chris-Transform: On
after the request line (well may be you need to do it after the Host:
header, I'm not sure whether the server expects the Host: header second).
Now your request level filter can lookup this header:
$filter->r->headers_in->get('X-Chris-Transform');
as simple as that.
Thanks for this.
I get errors when I try and use notes. Exact error is: Can't locate object method "note" via package "Apache::Connection"....
I have got a line reading "use Apache::Connection();" at the top of my code :)
I prefer the second method, however I'm having some problems with it. If
I add the header in the request filter, it doesn't appear to be set when
I do $filter->r->headers_in->get("X-iProxy");
The returned result is empty.
If I telnet into the proxy and type the request manually, with the header there, it works fine.
It's definitly adding the header in the request filter, but I can't retrieve it through the headers_in function. It only works when the client sends the "X-iProxy" header, not when it's added via the filter. Any ideas?
Actually it was a much more complicated task than I suggested. This is due to the assumptions taken by the headers_in core http filter which populates $r->headers_in. It wan't each header to reside in its own bucket. Moreover, it has to be in its own bucket brigade. So forget the streaming filter API and welcome bucket brigades. The implementation is still pretty trivial, but requires some tricky queueing and unqueueing of the headers, because each filter invocation needs to send exactly one header.
I suppose the headers_in core http filter does that in order to get a better performance. so it always grabs just the first bucket and ignores the rest. I should really look at its source code.
The following is a much more generic example than you need, so you will be able to simplify it a great deal. I'll commit that soon as a new test. I see some problem which I need to debug more, but it won't affect your task.
If you fail to comprehend my notes below and convert that example into what you want, I'll help you to get your particular task done, which should be pretty easy once you understand how the thing work ;)
In fact I'll commit that test, so you can see it in action, including the client side. Update your modperl-2.0 cvs, run
t/TEST -conf
to update the config
and now run:
/TEST -v -trace=debug filter/in_bbs_inject_header
and you will see a trace of everything that's happening inside the filter in error_log.
When I'll resolve the problem I see, I'll commit a fix. But the test passes regardless that problem.
Here is the code. It's pretty small if you remove all the comments.
package TestFilter::in_bbs_inject_header;
# this filter demonstrates two things: # 1. how to write a filter that will work only on HTTP headers # 2. how to inject extra HTTP headers # # the first task is simple -- as soon as a bucket which matches # /^[\r\n]+$/ is read we can store that event in the filter context and # simply 'return Apache::DECLINED on the future invocation, so not to # slow things. # # # the second task is a bit trickier, as the headers_in core httpd # filter is picky and it wants each header to arrive in a separate # bucket, and moreover this bucket needs to be in its own brigade. # so this test arranges for this to happen. # # the test shows how to push headers at the end of all headers # and in the middle, whichever way you prefer.
use strict; use warnings;# FATAL => 'all';
use base qw(Apache::Filter);
use Apache::RequestRec (); use Apache::RequestIO (); use APR::Brigade (); use APR::Bucket ();
use Apache::Test; use Apache::TestUtil; use Apache::TestTrace;
use Apache::Const -compile => qw(OK DECLINED); use APR::Const -compile => ':common';
my $header1_key = 'X-My-Protocol'; my $header1_val = 'POST-IT';
my %headers = (
'X-Extra-Header2' => 'Value 2',
'X-Extra-Header3' => 'Value 3',
);# returns 1 if a bucket with a header was inserted to the $bb's tail,
# otherwise returns 0 (i.e. if there are no buckets to insert)
sub inject_header_bucket {
my ($bb, $ctx) = @_;return 0 unless @{ $ctx->{buckets} };
my $bucket = shift @{ $ctx->{buckets} };
$bb->insert_tail($bucket); if (1) {
# extra debug, wasting cycles
my $data;
$bucket->read($data);
debug "injected header: [$data]";
}
else {
debug "injected header";
} # next filter invocations will bring the request body if any
if ($ctx->{seen_body_separator} && [EMAIL PROTECTED] $ctx->{buckets} }) {
$ctx->{done_with_headers} = 1;
$ctx->{seen_body_separator} = 0;
}return 1; }
sub handler : FilterConnectionHandler {
my($filter, $bb, $mode, $block, $readbytes) = @_;debug join '', "-" x 20 , " filter called ", "-" x 20;
use Data::Dumper;
warn Dumper $filter->ctx; my $ctx;
unless ($ctx = $filter->ctx) {
debug "filter context init";
$ctx = {
buckets => [],
done_with_headers => 0,
seen_body_separator => 0,
};
# since we are going to manipulate the reference stored in
# ctx, it's enough to store it only once, we will get the same
# reference in the following invocations of that filter
$filter->ctx($ctx);
} # handling the HTTP request body
if ($ctx->{done_with_headers}) {
# XXX: when the bug in httpd filter will be fixed all the
# code in this branch will be replaced with $filter->remove;
# at the moment (2.0.48) it doesn't work
# so meanwhile tell the mod_perl filter core to pass-through
# the brigade unmodified
debug "passing the body through unmodified";
#return Apache::DECLINED;
my $rv = $filter->next->get_brigade($bb, $mode, $block, $readbytes);
return $rv unless $rv == APR::SUCCESS;
return Apache::OK;
} # any custom HTTP header buckets to inject?
#return Apache::OK if inject_header_bucket($bb, $ctx); if (inject_header_bucket($bb, $ctx)) {
use Data::Dumper;
warn Dumper $ctx;
#$filter->ctx($ctx);
return Apache::OK;
} # normal HTTP headers processing
my $c = $filter->c;
my $ctx_bb = APR::Brigade->new($c->pool, $c->bucket_alloc);
my $rv = $filter->next->get_brigade($ctx_bb, $mode, $block, $readbytes);
return $rv unless $rv == APR::SUCCESS; while (!$ctx_bb->empty) {
my $data;
my $bucket = $ctx_bb->first;$bucket->remove;
if ($bucket->is_eos) {
debug "EOS!!!";
$bb->insert_tail($bucket);
last;
} my $status = $bucket->read($data);
debug "filter read:\n[$data]"; if ($status != APR::SUCCESS) {
return $status;
} if ($data and $data =~ /^POST/) {
# demonstrate how to add a header while processing other headers
my $header = "$header1_key: $header1_val\n";
push @{ $ctx->{buckets} }, APR::Bucket->new($header);
debug "queued header [$header]";
}
elsif ($data =~ /^[\r\n]+$/) {
# normally the body will start coming in the next call to
# get_brigade, so if your filter only wants to work with
# the headers, it can decline all other invocations if that
# flag is set. However since in this test we need to send
# a few extra bucket brigades, we will turn another flag
# 'done_with_headers' when 'seen_body_separator' is on and
# all headers were sent out
debug "END of original HTTP Headers";
$ctx->{seen_body_separator}++; # we hit the headers and body separator, which is a good
# time to add extra headers:
for my $key (keys %headers) {
my $header = "$key: $headers{$key}\n";
push @{ $ctx->{buckets} }, APR::Bucket->new($header);
debug "queued header [$header]";
} # but at the same time we must ensure that the
# the separator header will be sent as a last header
# so we send one newly added header and push the separator
# to the end of the queue
push @{ $ctx->{buckets} }, $bucket;
debug "queued header [$data]";
inject_header_bucket($bb, $ctx);
next; # inject_header_bucket already called insert_tail
# notice that if we didn't inject any headers, this will
# still work ok, as inject_header_bucket will send the
# separator header which we just pushed to its queue
}
else {
# fall through
} $bb->insert_tail($bucket);
}Apache::OK; }
sub response {
my $r = shift;plan $r, tests => 2 + keys %headers;
my $data = ModPerl::Test::read_post($r);
ok t_cmp(8, length($data), "whatever"); ok t_cmp($header1_val,
$r->headers_in->get($header1_key),
"injected header $header1_key"); for my $key (sort keys %headers) {
ok t_cmp($headers{$key},
$r->headers_in->get($key),
"injected header $key");
}Apache::OK; }
1;
__END__
<NoAutoConfig>
<VirtualHost TestFilter::in_bbs_inject_header>
# must be preloaded so the FilterConnectionHandler attributes will
# be set by the time the filter is inserted into the filter chain
PerlModule TestFilter::in_bbs_inject_header
#PerlInputFilterHandler ModPerl::TestFilterDebug::snoop_connection
PerlInputFilterHandler TestFilter::in_bbs_inject_header
#PerlInputFilterHandler ModPerl::TestFilterDebug::snoop_connection
<Location /TestFilter__in_bbs_inject_header>
SetHandler modperl
PerlResponseHandler TestFilter::in_bbs_inject_header::response
</Location></VirtualHost> </NoAutoConfig>
__________________________________________________________________ Stas Bekman JAm_pH ------> Just Another mod_perl Hacker http://stason.org/ mod_perl Guide ---> http://perl.apache.org mailto:[EMAIL PROTECTED] http://use.perl.org http://apacheweek.com http://modperlbook.org http://apache.org http://ticketmaster.com
