John Klar <[EMAIL PROTECTED]> writes:
> Yes, doable but quite messy. A colleage lamented the fact that
> LWP::Simple (he's into one-liners) is not usable with auth proxies.
>
> Therefore, having a few free cycles, I taught UserAgent how to
> deal with this. My version extracts the userinfo() portion of
> the proxy URI.
>
> I hope you find this patch useful. I am by no means a Perl hacker,
> so feel free to modify to taste.
>
> Usage:
>
> # export http_proxy="http://proxyuser:[EMAIL PROTECTED]:port"
>
> John Klar
>
> patch is against:
> # $Id: UserAgent.pm,v 1.77 2001/03/14 20:48:19 gisle Exp $--- UserAgent.pm.orig
> Wed Apr 4 15:33:50 2001
> +++ UserAgent.pm Wed Apr 4 15:41:27 2001
> @@ -177,6 +177,16 @@
> my $proxy = $self->_need_proxy($url);
> if (defined $proxy) {
> $scheme = $proxy->scheme;
> +
> + # Check the proxy URI's userinfo() for proxy credentials
> + # export http_proxy="http://proxyuser:proxypass@proxyhost:port"
> + my $p_auth = $proxy->userinfo();
> + if(defined $p_auth) {
> + my ($p_user,$p_pass) = split(':',$p_auth);
> + LWP::Debug::debug("PROXY AUTH BASIC: user: $p_user, pass: $p_pass");
> + $request->proxy_authorization_basic($p_user,$p_pass);
> + }
> +
> } else {
> $scheme = $url->scheme;
> }
Looks good, but to me it feels like the correct place for this hack is
in the LWP::Protocol::http module. Not that I actually expect us
start proxying over something else than HTTP anytime soon, but just in
case. The LWP design allow any protocol module to proxy.
This is the patch I checked in:
Index: lib/LWP/Protocol/http.pm
===================================================================
RCS file: /cvsroot/libwww-perl/lwp5/lib/LWP/Protocol/http.pm,v
retrieving revision 1.50
retrieving revision 1.51
diff -u -p -u -r1.50 -r1.51
--- lib/LWP/Protocol/http.pm 2000/05/24 09:41:13 1.50
+++ lib/LWP/Protocol/http.pm 2001/04/05 14:03:44 1.51
@@ -1,5 +1,5 @@
#
-# $Id: http.pm,v 1.50 2000/05/24 09:41:13 gisle Exp $
+# $Id: http.pm,v 1.51 2001/04/05 14:03:44 gisle Exp $
package LWP::Protocol::http;
@@ -60,7 +60,7 @@ sub _get_sock_info
sub _fixup_header
{
- my($self, $h, $url) = @_;
+ my($self, $h, $url, $proxy) = @_;
$h->remove_header('Connection'); # need support here to be useful
@@ -76,8 +76,19 @@ sub _fixup_header
if (defined($1) && not $h->header('Authorization')) {
require URI::Escape;
$h->authorization_basic(map URI::Escape::uri_unescape($_),
- split(":", $1));
+ split(":", $1, 2));
}
+
+ if ($proxy) {
+ # Check the proxy URI's userinfo() for proxy credentials
+ # export http_proxy="http://proxyuser:proxypass@proxyhost:port"
+ my $p_auth = $proxy->userinfo();
+ if(defined $p_auth) {
+ my($p_user, $p_pass) = split(':', $p_auth, 2);
+ LWP::Debug::debug("PROXY AUTH BASIC: user: $p_user, pass: $p_pass");
+ $h->proxy_authorization_basic($p_user, $p_pass);
+ }
+ }
}
@@ -141,7 +152,7 @@ sub request
if defined($$cont_ref) && length($$cont_ref);
}
- $self->_fixup_header($h, $url);
+ $self->_fixup_header($h, $url, $proxy);
my $buf = $request_line . $h->as_string($CRLF) . $CRLF;
my $n; # used for return value from syswrite/sysread
Thanks!
Regards,
Gisle
