[libwww-perl] 01/05: added patch to fix https proxy issue

[dod at debian.org]

This is an automated email from the git hooks/post-receive script.

dod pushed a commit to branch master
in repository libwww-perl.

commit 3cc808e840db650a38bc9932e9b8f0686458d5bf
Author: Dominique Dumont <dod at debian.org>
Date:   Fri Oct 11 18:51:19 2013 +0200

    added patch to fix https proxy issue
---
 debian/patches/handle-https-proxy |  107 +++++++++++++++++++++++++++++++++++++
 debian/patches/series             |    1 +
 2 files changed, 108 insertions(+)

diff --git a/debian/patches/handle-https-proxy b/debian/patches/handle-https-proxy
new file mode 100644
index 0000000..a9ab21e
--- /dev/null
+++ b/debian/patches/handle-https-proxy
@@ -0,0 +1,107 @@
+Description:Handle https proxy
+Bug:https://rt.cpan.org/Public/Bug/Display.html?id=1894
+Author:GMYERS [...] cpan.org 
+From:https://rt.cpan.org/Ticket/Attachment/989257/514980/libwww-perl-6.03-httpsproxy.patch
+--- a/lib/LWP/Protocol/http.pm
++++ b/lib/LWP/Protocol/http.pm
+@@ -15,7 +15,7 @@
+ 
+ sub _new_socket
+ {
+-    my($self, $host, $port, $timeout) = @_;
++    my($self, $host, $port, $timeout, $connectproxy) = @_;
+     my $conn_cache = $self->{ua}{conn_cache};
+     if ($conn_cache) {
+ 	if (my $sock = $conn_cache->withdraw($self->socket_type, "$host:$port")) {
+@@ -35,6 +35,7 @@
+ 					Timeout  => $timeout,
+ 					KeepAlive => !!$conn_cache,
+ 					SendTE    => 1,
++					ConnectProxy => $connectproxy,
+ 					$self->_extra_sock_opts($host, $port),
+ 				       );
+ 
+@@ -88,18 +89,26 @@
+ 
+ sub _fixup_header
+ {
+-    my($self, $h, $url, $proxy) = @_;
++    my($self, $h, $url, $proxy, $method) = @_;
+ 
+     # Extract 'Host' header
+     my $hhost = $url->authority;
+     if ($hhost =~ s/^([^\@]*)\@//) {  # get rid of potential "user:pass@"
+-	# add authorization header if we need them.  HTTP URLs do
+-	# not really support specification of user and password, but
+-	# we allow it.
+-	if (defined($1) && not $h->header('Authorization')) {
+-	    require URI::Escape;
+-	    $h->authorization_basic(map URI::Escape::uri_unescape($_),
+-				    split(":", $1, 2));
++	if ($method eq "CONNECT") {
++	    if (defined($1)) {
++		require URI::Escape;
++		$h->proxy_authorization_basic(map URI::Escape::uri_unescape($_),
++					      split(":", $1, 2));
++	    }
++	} else {
++	    # add authorization header if we need them.  HTTP URLs do
++	    # not really support specification of user and password, but
++	    # we allow it.
++	    if (defined($1) && not $h->header('Authorization')) {
++		require URI::Escape;
++		$h->authorization_basic(map URI::Escape::uri_unescape($_),
++					split(":", $1, 2));
++	    }
+ 	}
+     }
+     $h->init_header('Host' => $hhost);
+@@ -140,9 +149,13 @@
+     }
+ 
+     my $url = $request->uri;
+-    my($host, $port, $fullpath);
++    my($host, $port, $fullpath, $connectproxy);
+ 
+     # Check if we're proxy'ing
++    if (defined $proxy && $url->scheme() eq 'https') {
++	$connectproxy = $proxy;
++	undef $proxy;
++    }
+     if (defined $proxy) {
+ 	# $proxy is an URL to an HTTP server which will proxy this request
+ 	$host = $proxy->host;
+@@ -156,10 +169,11 @@
+ 	$port = $url->port;
+ 	$fullpath = $url->path_query;
+ 	$fullpath = "/$fullpath" unless $fullpath =~ m,^/,;
+-    }
++ 	$fullpath =~ s,^/,, if $method eq "CONNECT";
++     }
+ 
+     # connect to remote site
+-    my $socket = $self->_new_socket($host, $port, $timeout);
++    my $socket = $self->_new_socket($host, $port, $timeout, $connectproxy);
+ 
+     my $http_version = "";
+     if (my $proto = $request->protocol) {
+@@ -174,7 +188,7 @@
+ 
+     my @h;
+     my $request_headers = $request->headers->clone;
+-    $self->_fixup_header($request_headers, $url, $proxy);
++    $self->_fixup_header($request_headers, $url, $proxy, $method);
+ 
+     $request_headers->scan(sub {
+ 			       my($k, $v) = @_;
+--- a/lib/LWP/UserAgent.pm
++++ b/lib/LWP/UserAgent.pm
+@@ -166,7 +166,7 @@
+ 
+         # Locate protocol to use
+         my $proxy = $request->{proxy};
+-        if ($proxy) {
++        if ($proxy && $scheme ne 'https') {
+             $scheme = $proxy->scheme;
+         }
+ 
diff --git a/debian/patches/series b/debian/patches/series
new file mode 100644
index 0000000..6c9e95f
--- /dev/null
+++ b/debian/patches/series
@@ -0,0 +1 @@
+handle-https-proxy

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libwww-perl.git