POE HTTP Proxy

Discussion in 'Perl Misc' started by George Pabst, Oct 3, 2004.

  1. George Pabst

    George Pabst Guest

    Hello,

    I am working on creating a proxy server based off the example given on
    the poe.perl.org website for a HTTP Proxy.

    I have tried to change it to use streaming, however, I am finding that
    often the responses are incomplete and the wheels in
    POE::Component::Client::HTTP report read errors. This problem seems to
    be particularily bad when multiple requests are being made at the same
    time. However, when I do not use streaming, everything works fine.
    Interestingly, even without streaming there are still some read
    errors, but they do not seem to affect the content returned in the
    response object. I am making this proxy for a Windows system.

    I would be very happy if you could quickly take a look at the code to
    try and see why this is not working. The problem may be in the way
    POE::Component::Client::HTTP handles streaming (I am using v 1.56
    2004/07/13 18:02:37 rcaputo), but more likely its the way I am
    interfacing with-it.

    The only routine changed heavily is handle_http_response from the
    example off the POE website.

    Thanks in advance,
    George Pabst


    #!/usr/bin/perl

    use warnings;
    use strict;

    use POE;
    use POE::Component::Server::TCP;
    use POE::Component::Client::HTTP;
    use POE::Filter::HTTPD;

    use HTTP::Response;
    use Compress::Zlib;

    sub DUMP_REQUESTS () { 0 }
    sub DUMP_RESPONSES () { 0 }
    sub LISTEN_PORT () { 8088 }

    ### Spawn a web client to fetch requests through.

    our $HTTP_VER = '1.0'; # Version of HTTP to report to servers and
    clients
    our $COMPRESS_TEXT = 1; # GZIP compress HTML and text
    our $CRLF = "\015\012";
    our $COMPRESS_TEXT = 0;

    POE::Component::Client::HTTP->spawn(Protocol => "HTTP/$HTTP_VER",
    Alias => 'ua', Agent => 'Mozilla/4.0 (compatible;)', Streaming =>
    4096, FollowRedirects => 0);

    ### Spawn a web server.

    # The ClientInput function is called to deal with client input.
    # ClientInput's callback function will receive entire HTTP requests
    # because this server uses POE::Filter::HTTPD to parse its input.
    #
    # InlineStates let us attach our own events and handlers to a TCP
    # server. Here we attach a handler for the got_response event, which
    # will be sent to us by Client::HTTP when it has fetched something.

    POE::Component::Server::TCP->new
    ( Alias => "web_server",
    Port => LISTEN_PORT,
    ClientFilter => 'POE::Filter::HTTPD',

    ClientInput => \&handle_http_request,
    InlineStates => { got_response => \&handle_http_response, },
    );

    ### Run the proxy until it is done, then exit.

    POE::Kernel->run();
    exit 0;

    ### Handle HTTP requests from the client. Pass them to the HTTP
    ### client component for further processing. Optionally dump the
    ### request as text to STDOUT.

    sub handle_http_request {
    my ( $kernel, $heap, $request ) = @_[ KERNEL, HEAP, ARG0 ];

    # If the request is really a HTTP::Response, then it indicates a
    # problem parsing the client's request. Send the response back so
    # the client knows what's happened.
    if ( $request->isa("HTTP::Response") ) {
    $heap->{client}->put($request);
    $kernel->yield("shutdown");
    return;
    }

    # Client::HTTP doesn't support keep-alives yet.
    $request->header( "Connection", "close" );
    $request->header( "Proxy-Connection", "close" );
    $request->remove_header("Keep-Alive");

    display_thing( $request->as_string() ) if DUMP_REQUESTS;
    $heap->{client}->set_output_filter(POE::Filter::Stream->new() ) if
    (defined($heap->{client}));
    $kernel->post( "ua" => "request", "got_response", $request );
    }

    ### Handle HTTP responses from the POE::Component::Client::HTTP we've
    ### spawned at the beginning of the program. Send each response back
    ### to the client that requested it. Optionally display the response
    ### as text.

    sub handle_http_response{
    my ( $kernel, $heap ) = @_[ KERNEL, HEAP ];
    my $http_response = $_[ARG1]->[0];
    my $chunk = $_[ARG1]->[1];
    return if ((!$http_response) && (!$chunk));
    our($sent_headers);
    our($CRLF,$is_text);
    unless ( ($sent_headers) ) {
    $sent_headers = 1;
    if ($http_response->content_type =~ /text|html/i){
    $is_text = 1;
    print "Document is text\n";
    }
    else{
    # unless ($heap->{request}->header("X-IO-Error")){
    $http_response->protocol('HTTP/1.0');
    $http_response->remove_header("Content-Length") unless
    ($http_response->content_type);
    $heap->{client}->put($http_response->protocol . " " .
    $http_response->code . " (" . $http_response->message . ") " . $CRLF)
    if (defined($heap->{client}));
    print $http_response->code . " (" . $http_response->message . ")
    " . $http_response->protocol . $CRLF;
    $heap->{client}->put($http_response->headers_as_string($CRLF) .
    $CRLF) if (defined($heap->{client}));
    print $http_response->headers_as_string("\n") . "\n";
    $is_text = 0;
    # }
    # else{ print "Continuing disrupted connection for " .
    $heap->{request}->uri . "\n"; }
    }

    }

    our $chunksent;
    our ($content, $totlen);
    $totlen = 0 if (not defined $totlen);
    if ((defined($chunk) && $chunk ne '-1')){
    if (length($chunk) > 0 && $chunk ne '-1'){
    $heap->{client}->put($chunk) if ((not $is_text) &&
    defined($heap->{client}));
    print "Sent chunk of length " . length($chunk) . " bytes\n";
    $totlen += length($chunk);
    if (!defined($heap->{client})){
    $kernel->yield("shutdown");
    }
    $content .= $chunk if ($is_text == 1 && $chunk ne '-1');
    $totlen += length($chunk);
    }
    }
    else{

    my $clen = length($content);
    #if ($http_response->header("Content-Length") > $totlen){ #
    Response was not fully received
    # $heap->{request}->header("Range","bytes=$clen-" .
    $http_response->header("Content-Length"));
    # $heap->{request}->header("X-IO-Error",1);
    # print "Resending request with range header (Content-Length =
    $clen) " . $heap->{request}->header("Range") . " for " .
    $heap->{request}->uri . "\n";
    # $kernel->post( "streamua" => "request", "got_stream",
    $heap->{request} ); # Resubmit the request
    # return;
    #}
    $http_response->content($content);
    if ($http_response->header('Content-Encoding') =~ /gzip/i){

    $http_response->content(Compress::Zlib::memGunzip($http_response->content));
    $http_response->remove_header("Content-Encoding");

    }
    if ($COMPRESS_TEXT && ($http_response->code == 200) &&
    (lc($http_response->content_type) eq 'text/html') ||
    (lc($http_response->content_type) eq 'text/plain') &&
    ($heap->{request}->header("Accept-Encoding") =~ /gzip/i) &&
    ($http_response->header("Content-Encoding") !~ /gzip/i)){
    print "Length of content before gzip is " .
    length($http_response->content) . "\n";
    $http_response->content(Compress::Zlib::memGzip($http_response->content));
    $http_response->header("Content-Encoding","gzip");
    }
    if ($is_text == 1){
    $http_response->protocol('HTTP/1.0');

    if (($http_response->code == 200) &&
    ($http_response->content_type)){
    use bytes ();
    $http_response->header('Content-Length',bytes::length($http_response->content));
    }

    $heap->{client}->put($http_response->protocol . " " .
    $http_response->code . " (" . $http_response->message . ") " . $CRLF)
    if (defined($heap->{client}));
    print $http_response->protocol . " " . $http_response->code . " ("
    .. $http_response->message . ") " . $CRLF;
    $heap->{client}->put($http_response->headers_as_string($CRLF) .
    $CRLF) if (defined($heap->{client}));
    print $http_response->headers_as_string($CRLF) . $CRLF;

    $heap->{client}->put($http_response->content) if
    (defined($heap->{client}));
    print "Length of content at end of handle_http_response is " .
    length($http_response->content), "\n";
    }
    $content = '';
    $sent_headers = 0;
    $is_text = 0;
    $totlen = 0;
    $kernel->yield("shutdown");
    }
    }
    ### Display requests and responses with brackets around them so they
    ### stand apart.
    sub display_thing {
    my $thing = shift;
    $thing =~ s/^/| /mg;
    print ",", '-' x 78, "\n";
    print $thing;
    print "`", '-' x 78, "\n";
    }
    George Pabst, Oct 3, 2004
    #1
    1. Advertising

  2. George Pabst

    Rocco Caputo Guest

    On 3 Oct 2004 12:26:30 -0700, George Pabst wrote:
    > Hello,
    >
    > I am working on creating a proxy server based off the example given on
    > the poe.perl.org website for a HTTP Proxy.


    [...]

    You also posted this to POE's mailing list. At leant one response has
    already been posted there. In the interest of not duplicating effort,
    you should look there for responses.

    --
    Rocco Caputo - http://poe.perl.org/
    Rocco Caputo, Oct 4, 2004
    #2
    1. Advertising

Want to reply to this thread or ask your own question?

It takes just 2 minutes to sign up (and it's free!). Just click the sign up button to choose a username and then you can ask your own questions on the forum.
Similar Threads
  1. Fmp Fmpf
    Replies:
    0
    Views:
    81
    Fmp Fmpf
    May 27, 2008
  2. Michael Evanchik

    Can't locate POE.pm in @INC

    Michael Evanchik, Sep 22, 2003, in forum: Perl Misc
    Replies:
    3
    Views:
    565
    Sam Holden
    Sep 24, 2003
  3. Krisztian VASAS

    problem between perl-gtk2 and POE::Session

    Krisztian VASAS, Jun 21, 2004, in forum: Perl Misc
    Replies:
    1
    Views:
    99
    Rocco Caputo
    Jun 24, 2004
  4. Krisztian VASAS

    Problem with Gtk2 and POE

    Krisztian VASAS, Jun 28, 2004, in forum: Perl Misc
    Replies:
    4
    Views:
    117
    Rocco Caputo
    Jun 30, 2004
  5. Greg
    Replies:
    4
    Views:
    298
    Steven Simpson
    Aug 16, 2012
Loading...

Share This Page