r24853 - in /branches/upstream/libhttp-proxy-perl/current: Changes META.yml eg/logger.pl lib/HTTP/Proxy.pm lib/HTTP/Proxy/BodyFilter/save.pm t/23connect.t
gregoa at users.alioth.debian.org
gregoa at users.alioth.debian.org
Sat Sep 6 17:14:14 UTC 2008
Author: gregoa
Date: Sat Sep 6 17:14:12 2008
New Revision: 24853
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=24853
Log:
[svn-upgrade] Integrating new upstream version, libhttp-proxy-perl (0.23)
Modified:
branches/upstream/libhttp-proxy-perl/current/Changes
branches/upstream/libhttp-proxy-perl/current/META.yml
branches/upstream/libhttp-proxy-perl/current/eg/logger.pl
branches/upstream/libhttp-proxy-perl/current/lib/HTTP/Proxy.pm
branches/upstream/libhttp-proxy-perl/current/lib/HTTP/Proxy/BodyFilter/save.pm
branches/upstream/libhttp-proxy-perl/current/t/23connect.t
Modified: branches/upstream/libhttp-proxy-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libhttp-proxy-perl/current/Changes?rev=24853&op=diff
==============================================================================
--- branches/upstream/libhttp-proxy-perl/current/Changes (original)
+++ branches/upstream/libhttp-proxy-perl/current/Changes Sat Sep 6 17:14:12 2008
@@ -1,4 +1,14 @@
Revision history for Perl extension HTTP::Proxy
+
+0.23 Thu Sep 4 02:29:47 CEST 2008
+ [ENHANCEMENTS]
+ - HTTP::Proxy::BodyFilter::save had an issue with cygwin because
+ of an incorrect use of File::Spec's catdir(). This is fixed.
+ - CONNECT requests are now forwarded to the upstream proxy, if there
+ is one. Errors from the upstream proxy are relayed to the client.
+ [TESTS]
+ - t/23connect.t does not use sysread() anymore. This time the test
+ should pass about everywhere.
0.22 Thu May 1 00:18:38 CEST 2008
[TESTS]
Modified: branches/upstream/libhttp-proxy-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libhttp-proxy-perl/current/META.yml?rev=24853&op=diff
==============================================================================
--- branches/upstream/libhttp-proxy-perl/current/META.yml (original)
+++ branches/upstream/libhttp-proxy-perl/current/META.yml Sat Sep 6 17:14:12 2008
@@ -1,10 +1,12 @@
---
name: HTTP-Proxy
-version: 0.22
+version: 0.23
author:
- 'Philippe "BooK" Bruhat <book at cpan.org>'
abstract: A pure Perl HTTP proxy
license: perl
+resources:
+ license: http://dev.perl.org/licenses/
requires:
HTTP::Daemon: 1.25
LWP::UserAgent: 2
@@ -12,7 +14,7 @@
provides:
HTTP::Proxy:
file: lib/HTTP/Proxy.pm
- version: 0.22
+ version: 0.23
HTTP::Proxy::BodyFilter:
file: lib/HTTP/Proxy/BodyFilter.pm
HTTP::Proxy::BodyFilter::complete:
@@ -45,4 +47,7 @@
file: lib/HTTP/Proxy/HeaderFilter/simple.pm
HTTP::Proxy::HeaderFilter::standard:
file: lib/HTTP/Proxy/HeaderFilter/standard.pm
-generated_by: Module::Build version 0.26
+generated_by: Module::Build version 0.2808
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.2.html
+ version: 1.2
Modified: branches/upstream/libhttp-proxy-perl/current/eg/logger.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libhttp-proxy-perl/current/eg/logger.pl?rev=24853&op=diff
==============================================================================
--- branches/upstream/libhttp-proxy-perl/current/eg/logger.pl (original)
+++ branches/upstream/libhttp-proxy-perl/current/eg/logger.pl Sat Sep 6 17:14:12 2008
@@ -9,12 +9,18 @@
my %args = (
peek => [],
header => [],
+ mime => 'text/*',
);
{
my $args = '(' . join( '|', keys %args ) . ')';
for ( my $i = 0 ; $i < @ARGV ; $i += 2 ) {
if ( $ARGV[$i] =~ /$args/o ) {
- push @{ $args{$1} }, $ARGV[ $i + 1 ];
+ if ( ref $args{$1} ) {
+ push @{ $args{$1} }, $ARGV[ $i + 1 ];
+ }
+ else {
+ $args{$1} = $ARGV[ $i + 1 ];
+ }
splice( @ARGV, $i, 2 );
redo if $i < @ARGV;
}
@@ -31,10 +37,17 @@
# NOTE: Body request filters always receive the request body in one pass
my $post_filter = HTTP::Proxy::BodyFilter::simple->new(
- sub {
+ begin => sub { $_[0]->{binary} = 0; },
+ filter => sub {
my ( $self, $dataref, $message, $protocol, $buffer ) = @_;
print STDOUT "\n", $message->method, " ", $message->uri, "\n";
print_headers( $message, @clt_hdr );
+
+ if ( $self->{binary} || $$dataref =~ /\0/ ) {
+ $self->{binary} = 1;
+ print STDOUT " (not printing binary data)\n";
+ return;
+ }
# this is from CGI.pm, method parse_params()
my (@pairs) = split( /[&;]/, $$dataref );
@@ -83,7 +96,7 @@
$proxy->push_filter(
host => $_,
response => $get_filter,
- mime => 'text/*'
+ mime => $args{mime},
);
}
}
@@ -93,7 +106,7 @@
method => 'POST',
request => $post_filter
);
- $proxy->push_filter( response => $get_filter, mime => 'text/*' );
+ $proxy->push_filter( response => $get_filter, mime => $args{mime} );
}
$proxy->start;
Modified: branches/upstream/libhttp-proxy-perl/current/lib/HTTP/Proxy.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libhttp-proxy-perl/current/lib/HTTP/Proxy.pm?rev=24853&op=diff
==============================================================================
--- branches/upstream/libhttp-proxy-perl/current/lib/HTTP/Proxy.pm (original)
+++ branches/upstream/libhttp-proxy-perl/current/lib/HTTP/Proxy.pm Sat Sep 6 17:14:12 2008
@@ -20,7 +20,7 @@
DATA CONNECT ENGINE ALL );
%EXPORT_TAGS = ( log => [@EXPORT_OK] ); # only one tag
-$VERSION = '0.22';
+$VERSION = '0.23';
my $CRLF = "\015\012"; # "\r\n" is not portable
@@ -553,13 +553,48 @@
my $conn = $self->client_socket;
my $req = $self->request;
- my $upstream = IO::Socket::INET->new( PeerAddr => $req->uri->host_port );
- unless( $upstream and $upstream->connected ) {
- # 502 Bad Gateway / 504 Gateway Timeout
- # Note to implementors: some deployed proxies are known to
- # return 400 or 500 when DNS lookups time out.
- my $response = HTTP::Response->new( 200 );
+ my $upstream;
+
+ # connect upstream
+ if ( my $up = $self->agent->proxy('http') ) {
+
+ # clean up authentication info from proxy URL
+ $up =~ s{^http://[^/\@]*\@}{http://};
+
+ # forward to upstream proxy
+ $self->log( PROXY, "PROXY",
+ "Forwarding CONNECT request to next proxy: $up" );
+ my $response = $self->agent->simple_request($req);
+
+ # check the upstream proxy's response
+ my $code = $response->code;
+ if ( $code == 407 ) { # don't forward Proxy Authentication requests
+ my $response_407 = $response->as_string;
+ $response_407 =~ s/^Client-.*$//mg;
+ $response = HTTP::Response->new(502);
+ $response->content_type("text/plain");
+ $response->content( "Upstream proxy ($up) "
+ . "requested authentication:\n\n"
+ . $response_407 );
+ $self->response($response);
+ return $last;
+ }
+ elsif ( $code != 200 ) { # forward every other failure
+ $self->response($response);
+ return $last;
+ }
+
+ $upstream = $response->{client_socket};
+ }
+ else { # direct connection
+ $upstream = IO::Socket::INET->new( PeerAddr => $req->uri->host_port );
+ }
+
+ # no upstream socket obtained
+ if( !$upstream ) {
+ my $response = HTTP::Response->new( 500 );
$response->content_type( "text/plain" );
+ $response->content( "CONNECT failed: $@");
$self->response($response);
return $last;
}
Modified: branches/upstream/libhttp-proxy-perl/current/lib/HTTP/Proxy/BodyFilter/save.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libhttp-proxy-perl/current/lib/HTTP/Proxy/BodyFilter/save.pm?rev=24853&op=diff
==============================================================================
--- branches/upstream/libhttp-proxy-perl/current/lib/HTTP/Proxy/BodyFilter/save.pm (original)
+++ branches/upstream/libhttp-proxy-perl/current/lib/HTTP/Proxy/BodyFilter/save.pm Sat Sep 6 17:14:12 2008
@@ -97,7 +97,7 @@
$file = File::Spec->rel2abs( $file );
# create the directory
- my $dir = File::Spec->catdir( (File::Spec->splitpath($file))[ 0, 1 ] );
+ my $dir = File::Spec->catpath( (File::Spec->splitpath($file))[ 0, 1 ], '' );
if( ! -e $dir ) {
eval { mkpath( $dir ) };
if ($@) {
Modified: branches/upstream/libhttp-proxy-perl/current/t/23connect.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libhttp-proxy-perl/current/t/23connect.t?rev=24853&op=diff
==============================================================================
--- branches/upstream/libhttp-proxy-perl/current/t/23connect.t (original)
+++ branches/upstream/libhttp-proxy-perl/current/t/23connect.t Sat Sep 6 17:14:12 2008
@@ -6,6 +6,9 @@
plan skip_all => "This test fails on MSWin32. HTTP::Proxy is usable on Win32 with maxchild => 0"
if $^O eq 'MSWin32';
+
+# make sure we inherit no upstream proxy
+delete $ENV{$_} for qw( http_proxy HTTP_PROXY );
# test CONNECT
my $test = Test::Builder->new;
@@ -28,6 +31,7 @@
if ( !$pid ) {
my $sock = $server->accept;
$sock->print($banner);
+ sleep 1;
$sock->close;
exit;
}
@@ -49,7 +53,7 @@
);
# wait for the server and proxy to be ready
- sleep 4;
+ sleep 2;
# run a client
my $ua = LWP::UserAgent->new;
@@ -60,9 +64,18 @@
my $sock = $res->{client_socket};
+ # what does the proxy say?
+ is( $res->code, 200, "The proxy accepts CONNECT requests" );
+
+ # read a line
my $read;
- is( $res->code, 200, "The proxy accepts CONNECT requests" );
- ok( $sock->sysread( $read, 100 ), "Read some data from the socket" );
+ eval {
+ local $SIG{ALRM} = sub { die 'timeout' };
+ alarm 30;
+ $read = <$sock>;
+ };
+
+ ok( $read, "Read some data from the socket" );
is( $read, $banner, "CONNECTed to the TCP server and got the banner" );
close $sock;
More information about the Pkg-perl-cvs-commits
mailing list