Re: mod_perl 2.0 and print/send_http_header method SEGFAULT

[Stas Bekman]

Jérôme Augé wrote:

Hi,

I'm beginning with mod_perl (mod_perl-1.99_05 + Apache 2.0.40 from
RedHat 8.0) and I want to write a module for rewriting the documents
that passes through the Apache proxy. So, I looked at the
Apache::AdBlocker
(http://perl.apache.org/docs/tutorials/tips/mod_perl_tricks/mod_perl_tricks.html#A_Banner_Ad_Blocker)
module and I'm facing some problems for writing the content of the
documents back to the client.

My main problem is that I get a SEGFAULT when calling the "$r->print()"
or "$r->send_http_header()" method.
I get the request, copy the headers from "headers_in", make my own
request with LWP, copy the headers to "headers_out", then it SEGFAULT
when writing the document ... Are this methods deprecated/not fully
implemented ? what is the correct way to write data to the client ?

The other problem is that if I use the "$r->push_handlers(PerlHandler =>
\&proxy_handler)" mechanism, my "proxy_handler()" function is never
called, so I do the work directly into the handler sub, is this ok ?

I attached my test module below (I register it with a "PerlTransHandler
Apache::Plop" statement in httpd.conf)

After making your example work, I don't see any segfaults. Please try again with modperl-1.99_08 which was released a few days ago.

I've attached Plop.pm that apparently works. Hope that this is what you wanted to accomplish. I've used the following config:

<Location /plop/>
SetHandler perl-script
PerlHeaderParserHandler Apache::Plop
</Location>

Now to your code:

1. You can't push_handlers when you are inside a response handler.
Use PerlHeaderParserHandler instead

2. $r->headers_in->do() expects a return value and will abort on 0; see the attached code

also it should be:
$request->header( $_[0] => $_[1] );
instead of:
$request->header( {$_[0]} => $_[1] );

have you looked at error_log? You'd have seen that error reported.

3. This is not good:
my $request = HTTP::Request->new( $r->method, $r->uri);
since you don't the whole url. Use this instead:
my $request = HTTP::Request->new( $r->method, $r->construct_url);
this requires 'use Apache::URI'

4. Finally I've used a special header: (which can be anything)
$request->header( GetReal => 1 );
to know that now I'm inside the real request.

Hope that this helps.

Also you might want to use a sub-request rather than a heavy weighted LWP to accomplish what you do.

__________________________________________________________________
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

package Apache::Plop;

use strict;
use Apache::RequestRec;
use Apache::RequestIO;
use Apache::RequestUtil;
use Apache::Const;
use Apache::ServerUtil;
use Apache::Response;
use Apache::URI;
use APR::Table;
use LWP::UserAgent;

my $ua = LWP::UserAgent->new();

sub handler {
        my $r = shift;

        if( $r->proxyreq ) {
            return Apache::DECLINED;
        }
        print STDERR "Good, this is a proxyreq ...\n";

        $r->handler("perl-script"); #ok, let's do it               
        $r->push_handlers(PerlResponseHandler => \&proxy_handler);
        return Apache::OK;
}


sub proxy_handler {
    my $r = shift;

    if( $r->method ne "GET" ) {
        return Apache::DECLINED;
    }
    print STDERR "Good, this is a GET method ...\n";

    if ( ($r->headers_in->get('GetReal')||0) == 1) {
        $r->content_type('text/plain');
        print "hey";
        return Apache::OK;
    }

        # prepare the "real" request
    my $request = HTTP::Request->new( $r->method, $r->construct_url);

    # copy headers from client request
    my %headers_in;
    print STDERR "-- client headers --\n";
    $r->headers_in()->do(
        sub {
            warn "$_[0]: $_[1]\n";
            $headers_in{ $_[0] } = $_[1];
            $request->header( $_[0] => $_[1] );
            return 1;
        }
       );
    print STDERR "-- end --\n";

    # make the "real" request myself
    $ua->agent( $headers_in{ 'User-Agent' } );

    $request->header( GetReal => 1 );

    warn $request->as_string;

    my $response = $ua->request( $request );

    if ( ! $response->is_success() ) {
        print STDERR "== ERROR ==\n";
        return Apache::DECLINED;
    }

    print STDERR "-- server headers --\n";
    my %headers_out;
    $response->headers()->scan(
        sub {
            print STDERR "$_[0]: $_[1]\n";
            $headers_out{$_[0]} = $_[1];
        }
       );
    print STDERR "-- end --\n";

    # simply override the content
    my $content = $response->content;
    $content = "<html><body>plop</body></html>";

    # adjust the headers for the new content
    $headers_out{ 'Content-length' } = length( $content );
    $headers_out{ 'Content-type' } = 'text/html';

    # copy the modified response headers back to Apache
    foreach (keys %headers_out) {
        $r->headers_out->{$_} = $headers_out{$_};
    }
    $r->content_type( $headers_out{ 'Content-type' } );

    print STDERR "-- send/print --\n";

    $r->send_http_header();
    $r->print( $content );

    print STDERR "-- end --\n";

    return Apache::OK;
}

1;