Skip Menu |
 

This queue is for tickets about the POE-Component-Client-HTTP CPAN distribution.

Report information
The Basics
Id: 14011
Status: resolved
Priority: 0/
Queue: POE-Component-Client-HTTP

People
Owner: Nobody in particular
Requestors: tech [...] askold.net
Cc:
AdminCc:

Bug Information
Severity: Wishlist
Broken in: (no value)
Fixed in: (no value)



Subject: testpack for proxy mode
Download (untitled) / with headers
text/plain 100b
This is placeholder, to inform that I'm working on it. In a week I will finish and attach testpack.
From: tech [...] askold.net
Download (untitled) / with headers
text/plain 876b
[YKAR - Thu Aug 4 06:14:09 2005]: 8 tests. Tests 1-4 GET method tests. Simply send GET queries and verify did PoCo::Client::HTTP connected to right place and send right request. 1. Default proxy set, per request unset 2. Default proxy set, per request also set 3. Default proxy unset, per request set 4. Default proxy unset, per request unset (no proxy used) Tests 5-8 POST method tests. This test send POST request with body which contain random cookie and verify did PoCo::Client::HTTP connected to right place received right URI in request, and received right request body. 5. Default proxy set, per request unset 6. Default proxy set, per request also set 7. Default proxy unset, per request set 8. Default proxy unset, per request unset (no proxy used) Show quoted text
> This is placeholder, to inform that I'm working on it. > > In a week I will finish and attach testpack.
Download 40_proxy.t
text/x-perl 6k
#! /usr/bin/perl # -*- perl -*- use strict; use warnings; use Test::More tests => 8; $SIG{PIPE} = 'IGNORE'; use Socket; use POE; use POE::Session; use POE::Component::Server::TCP; use POE::Component::Client::HTTP; use POE::Filter::HTTPD; use HTTP::Request; use HTTP::Request::Common qw(GET PUT); use HTTP::Response; POE::Session->create ( inline_states => { _start => sub { my $kernel = $_[KERNEL]; $kernel->alias_set('main'); spawn_http('proxy1'); spawn_http('proxy2'); spawn_http('host'); }, set_port => sub { my ($kernel, $heap, $name, $port) = @_[KERNEL, HEAP, ARG0, ARG1]; $heap->{$name} = "http://127.0.0.1:$port/"; if (++ $_[HEAP]->{ready_cnt} == 3) { $_[KERNEL]->yield('begin_tests'); } }, begin_tests => sub { my ($kernel, $heap) = @_[KERNEL, HEAP]; POE::Component::Client::HTTP->spawn(Alias => 'DefProxy', Proxy => $heap->{proxy1}); POE::Component::Client::HTTP->spawn(Alias => 'NoProxy'); # Test is default proxy working $kernel->post(DefProxy => request => test1_resp => GET $heap->{host}); }, test1_resp => sub { my ($kernel, $heap, $resp_pack) = @_[KERNEL, HEAP, ARG1]; my $resp = $resp_pack->[0]; ok($resp->is_success && $resp->content eq 'proxy1'); # Test is default proxy override working $kernel->post(DefProxy => request => test2_resp => (GET $heap->{host}), undef, undef, $heap->{proxy2}); }, test2_resp => sub { my ($kernel, $heap, $resp_pack) = @_[KERNEL, HEAP, ARG1]; my $resp = $resp_pack->[0]; ok($resp->is_success && $resp->content eq 'proxy2'); # Test per request proxy setting (override with no default proxy) $kernel->post(NoProxy => request => test3_resp => (GET $heap->{host}), undef, undef, $heap->{proxy1}); }, test3_resp => sub { my ($kernel, $heap, $resp_pack) = @_[KERNEL, HEAP, ARG1]; my $resp = $resp_pack->[0]; ok($resp->is_success && $resp->content eq 'proxy1'); # Test when no proxy set at all $kernel->post(NoProxy => request => test4_resp => GET $heap->{host}); }, test4_resp => sub { my ($kernel, $heap, $resp_pack) = @_[KERNEL, HEAP, ARG1]; my $resp = $resp_pack->[0]; ok($resp->is_success && $resp->content eq 'host'); # Test is default proxy works for POST $heap->{cookie} = rand; my $req = HTTP::Request->new(POST => $heap->{host}, ['Content-Length' => length($heap->{cookie})], $heap->{cookie}); $kernel->post(DefProxy => request => test5_resp => $req); }, test5_resp => sub { my ($kernel, $heap, $resp_pack) = @_[KERNEL, HEAP, ARG1]; my $resp = $resp_pack->[0]; if ($resp->is_success) { my ($name, $content) = split(':', $resp->content); ok($name eq 'proxy1' && $content eq $heap->{cookie}); } else { fail(); } # Test is default proxy override works for POST $heap->{cookie} = rand; my $req = HTTP::Request->new(POST => $heap->{host}, ['Content-Length' => length($heap->{cookie})], $heap->{cookie}); $kernel->post(DefProxy => request => test6_resp => $req, undef, undef, $heap->{proxy2}); }, test6_resp => sub { my ($kernel, $heap, $resp_pack) = @_[KERNEL, HEAP, ARG1]; my $resp = $resp_pack->[0]; if ($resp->is_success) { my ($name, $content) = split(':', $resp->content); ok($name eq 'proxy2' && $content eq $heap->{cookie}); } else { fail(); } # Test is per request proxy works for POST $heap->{cookie} = rand; my $req = HTTP::Request->new(POST => $heap->{host}, ['Content-Length' => length($heap->{cookie})], $heap->{cookie}); $kernel->post(NoProxy => request => test7_resp => $req, undef, undef, $heap->{proxy1}); }, test7_resp => sub { my ($kernel, $heap, $resp_pack) = @_[KERNEL, HEAP, ARG1]; my $resp = $resp_pack->[0]; if ($resp->is_success) { my ($name, $content) = split(':', $resp->content); ok($name eq 'proxy1' && $content eq $heap->{cookie}); } else { fail(); } # Test is no for POST $heap->{cookie} = rand; my $req = HTTP::Request->new(POST => $heap->{host}, ['Content-Length' => length($heap->{cookie})], $heap->{cookie}); $kernel->post(NoProxy => request => test8_resp => $req); }, test8_resp => sub { my ($kernel, $heap, $resp_pack) = @_[KERNEL, HEAP, ARG1]; my $resp = $resp_pack->[0]; if ($resp->is_success) { my ($name, $content) = split(':', $resp->content); ok($name eq 'host' && $content eq $heap->{cookie}); } else { fail(); } $kernel->post(proxy1 => 'shutdown'); $kernel->post(proxy2 => 'shutdown'); $kernel->post(host => 'shutdown'); } }, heap => { ready_cnt => 0 } ); POE::Kernel->run(); exit 0; sub spawn_http { my $name = shift; POE::Component::Server::TCP->new ( Alias => $name, Address => '127.0.0.1', Port => 0, ClientFilter => 'POE::Filter::HTTPD', ClientInput => sub { unshift @_, $name; &handle_request }, Started => sub { my ($kernel, $heap) = @_[KERNEL, HEAP]; my $port = (sockaddr_in($heap->{listener}->getsockname))[0]; $kernel->post('main', 'set_port', $name, $port); } ); } sub handle_request { my $name = shift; my ($kernel, $heap, $request) = @_[KERNEL, HEAP, ARG0]; if ( $request->isa("HTTP::Response") ) { $heap->{client}->put($request); $kernel->yield("shutdown"); return; } my ($body, $port); if ((($name =~ /^proxy/ && defined ($port = $kernel->alias_resolve('main')->get_heap->{http}) && $request->uri->canonical ne "http://127.0.0.1:$port/") || ($name !~ /^proxy/ && $request->uri->canonical ne '/'))) { $body = 'url does not match'; } else { $body = $name; } if ($request->method eq "POST") { # passthrough cookie $body .= ':' . $request->content; } my $r = HTTP::Response->new ( 200, 'OK', ['Connection' => 'Close', 'Content-Type' => 'text/plain'], $body ); $heap->{client}->put($r) if defined $heap->{client}; $kernel->yield("shutdown"); }
Thank you very much. I have reformatted your code slightly and committed it as t/07_proxy.t.


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.