use strict;
use warnings;
sub POE::Component::Server::SimpleHTTP::DEBUG () { 1 }
use POE qw(Component::Client::HTTP Component::Server::SimpleHTTP);
use POE::Component::Server::SimpleHTTP::Response;
# Stolen from POE::Wheel. This is static data, shared by all
my $current_id = 0;
my %active_identifiers;
sub _allocate_identifier {
while (1) {
last unless exists $active_identifiers{ ++$current_id };
}
return $active_identifiers{$current_id} = $current_id;
}
sub _free_identifier {
my $id = shift;
delete $active_identifiers{$id};
}
my $agent = 'proxy' . $$;
my $httpd = 'HTTPD' . $$;
POE::Component::Client::HTTP->spawn(
Alias => $agent,
Streaming => 4096,
);
POE::Component::Server::SimpleHTTP->new(
KEEPALIVE => 1,
ALIAS => $httpd,
PORT => 11111,
PROXYMODE => 1,
HANDLERS => [
{
DIR => '.*',
SESSION => 'controller',
EVENT => 'got_request',
},
],
);
POE::Session->create(
package_states => [
main => [qw(_start got_request _got_stream _response)],
],
);
$poe_kernel->run();
exit 0;
sub _start {
$poe_kernel->alias_set( 'controller' );
return;
}
sub got_request {
my($kernel,$heap,$request,$response,$dirmatch) = @_[KERNEL,HEAP,ARG0..ARG2];
my $httpd = $_[SENDER]->get_heap();
use Data::Dumper;
$Data::Dumper::Indent=1;
print Dumper( $response );
# Check for errors
if ( ! defined $request ) {
$kernel->post( $httpd, 'DONE', $response );
return;
}
$request->header('Connection', 'Keep-Alive');
$request->remove_header('Accept-Encoding');
# Let's see if it is a CONNECT request
warn $request->as_string;
warn $request->method, "\n";
if ( $request->method eq 'CONNECT' ) {
my $uri = $request->uri;
# warn $uri->authority, "\n";
warn $uri->as_string, "\n";
}
$response->stream(
session => 'controller',
event => '_got_stream',
dont_flush => 1
);
my $id = _allocate_identifier();
$kernel->post(
$agent,
'request',
'_response',
$request,
"$id",
);
$heap->{_requests}->{ $id } = $response;
return;
}
sub _response {
my ($kernel,$heap,$request_packet,$response_packet) = @_[KERNEL,HEAP,ARG0,ARG1];
my $id = $request_packet->[1];
my $resp = $heap->{_requests}->{ $id };
my $response = _rebless( $resp, $response_packet->[0] );
my $chunk = $response_packet->[1];
warn $response->headers_as_string, "\n";
if ( $chunk ) {
$response->content( $chunk );
$kernel->post( $httpd, 'STREAM', $response );
}
else {
$kernel->post( $httpd, 'DONE', $response );
}
return;
}
sub _got_stream {
my ($kernel,$heap,$response) = @_[KERNEL,HEAP,ARG0];
return;
}
sub _rebless {
my ($orig,$new) = @_;
$new->{$_} = $orig->{$_} for grep { exists $orig->{$_} }
qw(_WHEEL connection STREAM_SESSION STREAM DONT_FLUSH IS_STREAMING);
bless $new, 'POE::Component::Server::SimpleHTTP::Response';
return $new;
}