Skip Menu |

This queue is for tickets about the Net-Async-HTTP CPAN distribution.

Report information
The Basics
Id: 96501
Status: new
Priority: 0/
Queue: Net-Async-HTTP
People
Owner: leonerd-cpan [...] leonerd.org.uk
Requestors: DAKKAR [...] cpan.org
Cc:
AdminCc:
Bug Information
Severity: Important
Broken in: 0.35
Fixed in: (no value)

History Show all quoted text
  Tue Jun 17 09:24:30 2014 DAKKAR [...] cpan.org - Ticket created
Subject: Proxy support appears broken
I have a machine that get reach the web only via a non transparent proxy (Squid). Sample code: #!/usr/bin/env perl use strict;use warnings; use IO::Async::Loop; use Net::Async::HTTP; use Future; my $l = IO::Async::Loop->new; my $ua = Net::Async::HTTP->new( proxy_host => 'the-proxy.local', proxy_port => 3128, ); $l->add($ua); $ua->GET( 'https://xmlpitest-ea.dhl.com/XMLShippingServlet', ) ->then(sub{say "Success!";say p @_;return Future->wrap();}) ->else(sub{say "Fail!";say p @_;return Future->wrap();})->get; This fails with: proxy1-dev.dave.net-a-porter.com:3128 - SSL connect attempt failed with unknown error error:140770FC:SSL routines:SSL23_GET_SERVER_HELLO:unknown protocol failed [ssl] It's trying to talk SSL to the proxy, which is not what I need it to do. Worse: if I change the code to request a non-https url, I get an 400 error page from the proxy, saying that it could not forward a request for C</XMLShippingServlet>, showing that L<Net::Async::HTTP> is talking to the proxy like it were the destination server. Both of these behaviours are wrong. The fix appears to be non-trivial though, and I'm not even sure how to write a useful test script. Apologies for the lack of tests and patches.
  Tue Jun 24 05:39:05 2014 DAKKAR [...] cpan.org - Correspondence added
Attached: code & tests patch to implement the simplest proxy behaviour, without HTTPS/CONNECT. It should probably die if passed a non-absolute URI.
Subject: 0001-RT-96501-simple-HTTP-via-proxy-support.patch
From 6b1b51b8c3a73478998d3f4ea7332718d4e343d6 Mon Sep 17 00:00:00 2001 From: Gianni Ceccarelli <gianni.ceccarelli@net-a-porter.com> Date: Tue, 24 Jun 2014 10:35:09 +0100 Subject: [PATCH] RT-96501 simple HTTP-via-proxy support --- lib/Net/Async/HTTP.pm | 2 ++ lib/Net/Async/HTTP/Connection.pm | 14 ++++++++++---- t/01request.t | 34 +++++++++++++++++++++++++++++++--- 3 files changed, 43 insertions(+), 7 deletions(-) diff --git a/lib/Net/Async/HTTP.pm b/lib/Net/Async/HTTP.pm index 21e299e..f118d35 100644 --- a/lib/Net/Async/HTTP.pm +++ b/lib/Net/Async/HTTP.pm @@ -384,6 +384,7 @@ sub get_connection ready_queue => $ready_queue, ( map { $_ => $self->{$_} } qw( max_in_flight pipeline read_len write_len decode_content ) ), + is_proxy => $args{is_proxy}, on_closed => sub { my $conn = shift; @@ -614,6 +615,7 @@ sub _do_one_request return $self->get_connection( host => $args{proxy_host} || $self->{proxy_host} || $host, port => $args{proxy_port} || $self->{proxy_port} || $port, + is_proxy => !!($args{proxy_host} || $self->{proxy_host}), SSL => $args{SSL}, ( map { m/^SSL_/ ? ( $_ => $args{$_} ) : () } keys %args ), )->then( sub { diff --git a/lib/Net/Async/HTTP/Connection.pm b/lib/Net/Async/HTTP/Connection.pm index 174593f..f993a39 100644 --- a/lib/Net/Async/HTTP/Connection.pm +++ b/lib/Net/Async/HTTP/Connection.pm @@ -52,7 +52,7 @@ sub configure my $self = shift; my %params = @_; - foreach (qw( pipeline max_in_flight ready_queue decode_content )) { + foreach (qw( pipeline max_in_flight ready_queue decode_content is_proxy )) { $self->{$_} = delete $params{$_} if exists $params{$_}; } @@ -540,7 +540,8 @@ sub request } }; - # Unless the request method is CONNECT, the URL is not allowed to contain + # Unless the request method is CONNECT, or we are connecting to a + # non-transparent proxy, the URL is not allowed to contain # an authority; only path # Take a copy of the headers since we'll be hacking them up my $headers = $req->headers->clone; @@ -550,8 +551,13 @@ sub request } else { my $uri = $req->uri; - $path = $uri->path_query; - $path = "/$path" unless $path =~ m{^/}; + if ( $self->{is_proxy} ) { + $path = $uri->as_string; + } + else { + $path = $uri->path_query; + $path = "/$path" unless $path =~ m{^/}; + } my $authority = $uri->authority; if( defined $authority and my ( $user, $pass, $host ) = $authority =~ m/^(.*?):(.*)@(.*)$/ ) { diff --git a/t/01request.t b/t/01request.t index 0181298..f4dd0b4 100644 --- a/t/01request.t +++ b/t/01request.t @@ -35,7 +35,8 @@ sub do_test_req my $error; my $request = $args{req}; - my $host = $args{no_host} ? $request->uri->host : "host$hostnum"; $hostnum++; + my $host = $args{no_host} ? $request->uri->host : $http->{proxy_host} || "host$hostnum"; $hostnum++; + my $service = $http->{proxy_port} || 80; my $peersock; no warnings 'redefine'; @@ -43,8 +44,8 @@ sub do_test_req my $self = shift; my %args = @_; - $args{host} eq $host or die "Expected $args{host} eq $host"; - $args{service} eq "80" or die "Expected $args{service} eq 80"; + $args{host} eq $host or die "Expected $args{host} eq $host"; + $args{service} eq $service or die "Expected $args{service} eq $service"; ( my $selfsock, $peersock ) = IO::Async::OS->socketpair() or die "Cannot create socket pair - $!"; $self->set_handle( $selfsock ); @@ -218,6 +219,33 @@ do_test_req( "GET to full URL", expect_res_content => "Hello, world!", ); +$http->configure(proxy_host => 'proxyhost',proxy_port=>3128); +do_test_req( "GET over proxy", + req => $req, + host => "myhost", + + expect_req_firstline => "GET http://myhost/some/path HTTP/1.1", + expect_req_headers => { + Host => "myhost", + }, + + response => "HTTP/1.1 200 OK$CRLF" . + "Content-Length: 13$CRLF" . + "Content-Type: text/plain$CRLF" . + "Connection: Keep-Alive$CRLF" . + $CRLF . + "Hello, world!", + + expect_res_code => 200, + expect_res_headers => { + 'Content-Length' => 13, + 'Content-Type' => "text/plain", + 'Connection' => "Keep-Alive", + }, + expect_res_content => "Hello, world!", +); +$http->configure(proxy_host => undef,proxy_port=>undef); + $req = HTTP::Request->new( GET => "/empty", [ Host => "myhost" ] ); do_test_req( "GET with empty body", -- 1.8.5.5