Proxy authentication fix: PATCH
Aaron J. Sherman (ajs@kr.com)
Mon, 17 Mar 1997 15:30:38 -0500 (EST)
The following is a simple patch to get proxy authentication to work. It is
based on 5.07, and works for the Netscape Proxy Server that I have installed.
More thought (and an actual perusal of the standards involved) needs to
be put into this. Right now, I just use the same code for both regular
authentication and proxy auth. The only difference is that for proxy
auth, I use the proxy URL as the relative-URL for getting credentials.
This may break if proxies try to get too smart....
*** /usr/new/src/perl/libwww-perl-5.07/lib/LWP/UserAgent.pm Tue Feb 11 08:47:42 1997
--- LWP/UserAgent.pm Mon Mar 17 15:07:31 1997
***************
*** 1,4 ****
--- 1,5 ----
# $Id: UserAgent.pm,v 1.42 1997/02/11 13:47:41 aas Exp $
+ # With modifications by Aaron Sherman <ajs@ajs.com> to support proxy auth
package LWP::UserAgent;
***************
*** 316,442 ****
warn "RC_UNAUTHORIZED without WWW-Authenticate\n";
return $response;
}
- if (($challenge =~ /^(\S+)\s+Realm\s*=\s*"(.*?)"/i) or
- ($challenge =~ /^(\S+)\s+Realm\s*=\s*<([^<>]*)>/i) or
- ($challenge =~ /^(\S+)$/)
- ) {
! my($scheme, $realm) = ($1, $2);
! if ($scheme =~ /^Basic$/i) {
! my($uid, $pwd) = $self->get_basic_credentials($realm,
! $request->url);
! if (defined $uid and defined $pwd) {
! my $uidpwd = "$uid:$pwd";
! my $header = "$scheme " . encode_base64($uidpwd, '');
! # Need to check this isn't a repeated fail!
! my $r = $response;
! while ($r) {
! my $auth = $r->request->header('Authorization');
! if ($auth && $auth eq $header) {
! # here we know this failed before
! $response->message('Invalid Credentials');
! return $response;
! }
! $r = $r->previous;
! }
! my $referral = $request->clone;
! $referral->header('Authorization' => $header);
!
! return $self->request($referral, $arg, $size, $response);
! } else {
! return $response; # no password found
! }
! } elsif ($scheme =~ /^Digest$/i) {
! # http://hopf.math.nwu.edu/digestauth/draft.rfc
! require MD5;
! my $md5 = new MD5;
! my($uid, $pwd) = $self->get_basic_credentials($realm,
! $request->url);
! my $string = $challenge;
! $string =~ s/^$scheme\s+//;
! $string =~ s/"//g; #" unconfuse emacs
! my %mda = map { split(/,?\s+|=/) } $string;
!
! my(@digest);
! $md5->add(join(":", $uid, $mda{realm}, $pwd));
! push(@digest, $md5->hexdigest);
! $md5->reset;
!
! push(@digest, $mda{nonce});
!
! $md5->add(join(":", $request->method, $request->url->path));
! push(@digest, $md5->hexdigest);
! $md5->reset;
!
! $md5->add(join(":", @digest));
! my($digest) = $md5->hexdigest;
! $md5->reset;
!
! my %resp = map { $_ => $mda{$_} } qw(realm nonce opaque);
! @resp{qw(username uri response)} =
! ($uid, $request->url->path, $digest);
!
! if (defined $uid and defined $pwd) {
! my(@order) = qw(username realm nonce uri response);
! if($request->method =~ /^(?:POST|PUT)$/) {
! $md5->add($request->content);
! my($content) = $md5->hexdigest;
! $md5->reset;
! $md5->add(join(":", @digest[0..1], $content));
! $md5->reset;
! $resp{"message-digest"} = $md5->hexdigest;
! push(@order, "message-digest");
! }
! push(@order, "opaque");
! my @pairs;
! for (@order) {
! next unless defined $resp{$_};
! push(@pairs, "$_=" . qq("$resp{$_}"));
! }
! my $header = "$scheme " . join(", ", @pairs);
!
! # Need to check this isn't a repeated fail!
! my $r = $response;
! while ($r) {
! my $auth = $r->request->header('Authorization');
! if ($auth && $auth eq $header) {
! # here we know this failed before
! $response->message('Invalid Credentials');
! return $response;
! }
! $r = $r->previous;
! }
!
! my $referral = $request->clone;
! #$referral->header('Extension' => "Security/Digest");
! $referral->header('Authorization' => $header);
! return $self->request($referral, $arg, $size, $response);
! } else {
! return $response; # no password found
! }
! } else {
! my $class = "LWP::Authen::$scheme";
! eval "use $class ()";
! if($@) {
! warn $@;
! warn "Authentication scheme '$scheme' not supported\n";
! return $response;
! }
! return $class->authenticate($self, $response, $request, $arg, $size, $scheme, $realm);
! }
! } else {
! warn "Unknown challenge '$challenge'";
! return $response;
! }
!
! } elsif ($code == &HTTP::Status::RC_PAYMENT_REQUIRED or
! $code == &HTTP::Status::RC_PROXY_AUTHENTICATION_REQUIRED) {
! warn 'Resolution of' . HTTP::Status::status_message($code) .
! 'not yet implemented';
return $response;
}
$response;
--- 317,342 ----
warn "RC_UNAUTHORIZED without WWW-Authenticate\n";
return $response;
}
! # Authentication modularized by Aaron Sherman <ajs@ajs.com> 3/17/97
! return $self->_ua_authenticate($challenge,$response,$request,
! 'Authorization');
! } elsif ($code == &HTTP::Status::RC_PROXY_AUTHENTICATION_REQUIRED) {
! my $challenge = $response->header('Proxy-authenticate');
! unless (defined $challenge) {
! warn "RC_UNAUTHORIZED without Proxy-authenticate\n";
! return $response;
! }
! return $self->_ua_authenticate($challenge,$response,$request,
! 'Proxy-authorization');
! } elsif ($code == &HTTP::Status::RC_PAYMENT_REQUIRED) {
! # Added spaces so output was readable -ajs@ajs.com 3/17/96
! warn 'Resolution of ' . HTTP::Status::status_message($code) .
! ' not yet implemented';
return $response;
}
$response;
***************
*** 585,590 ****
--- 485,619 ----
sub no_proxy;
sub _need_proxy;
+
+ # Private method that returns the authentication header for a request
+ sub _ua_authenticate {
+ my $self = shift;
+ my $challenge = shift;
+ my $response = shift;
+ my $request = shift;
+ my $auth_header = shift;
+ my $relative_to = ($auth_header=~/proxy/)?$self->proxy:$request->url;
+
+ if (($challenge =~ /^(\S+)\s+Realm\s*=\s*"(.*?)"/i) or
+ ($challenge =~ /^(\S+)\s+Realm\s*=\s*<([^<>]*)>/i) or
+ ($challenge =~ /^(\S+)$/)
+ ) {
+
+ my($scheme, $realm) = ($1, $2);
+
+ if ($scheme =~ /^Basic$/i) {
+
+ my($uid, $pwd) = $self->get_basic_credentials($realm, $relative_to);
+
+ if (defined $uid and defined $pwd) {
+ my $uidpwd = "$uid:$pwd";
+ my $header = "$scheme " . encode_base64($uidpwd, '');
+
+ # Need to check this isn't a repeated fail!
+ my $r = $response;
+ while ($r) {
+ my $auth = $r->request->header($auth_header);
+ if ($auth && $auth eq $header) {
+ # here we know this failed before
+ $response->message('Invalid Credentials');
+ return $response;
+ }
+ $r = $r->previous;
+ }
+
+ my $referral = $request->clone;
+ $referral->header($auth_header => $header);
+
+ return $self->request($referral, $arg, $size, $response);
+ } else {
+ return $response; # no password found
+ }
+ } elsif ($scheme =~ /^Digest$/i) {
+ # XXX NOTE: The meaning of this scheme for proxy authentication
+ # has not been thought through.
+ # http://hopf.math.nwu.edu/digestauth/draft.rfc
+ require MD5;
+ my $md5 = new MD5;
+ my($uid, $pwd) = $self->get_basic_credentials($realm,$relative_to);
+ my $string = $challenge;
+ $string =~ s/^$scheme\s+//;
+ $string =~ s/"//g; #" unconfuse emacs
+ my %mda = map { split(/,?\s+|=/) } $string;
+
+ my(@digest);
+ $md5->add(join(":", $uid, $mda{realm}, $pwd));
+ push(@digest, $md5->hexdigest);
+ $md5->reset;
+
+ push(@digest, $mda{nonce});
+
+ $md5->add(join(":", $request->method, $request->url->path));
+ push(@digest, $md5->hexdigest);
+ $md5->reset;
+
+ $md5->add(join(":", @digest));
+ my($digest) = $md5->hexdigest;
+ $md5->reset;
+
+ my %resp = map { $_ => $mda{$_} } qw(realm nonce opaque);
+ @resp{qw(username uri response)} =
+ ($uid, $request->url->path, $digest);
+
+ if (defined $uid and defined $pwd) {
+ my(@order) = qw(username realm nonce uri response);
+ if($request->method =~ /^(?:POST|PUT)$/) {
+ $md5->add($request->content);
+ my($content) = $md5->hexdigest;
+ $md5->reset;
+ $md5->add(join(":", @digest[0..1], $content));
+ $md5->reset;
+ $resp{"message-digest"} = $md5->hexdigest;
+ push(@order, "message-digest");
+ }
+ push(@order, "opaque");
+ my @pairs;
+ for (@order) {
+ next unless defined $resp{$_};
+ push(@pairs, "$_=" . qq("$resp{$_}"));
+ }
+ my $header = "$scheme " . join(", ", @pairs);
+
+ # Need to check this isn't a repeated fail!
+ my $r = $response;
+ while ($r) {
+ my $auth = $r->request->header($auth_header);
+ if ($auth && $auth eq $header) {
+ # here we know this failed before
+ $response->message('Invalid Credentials');
+ return $response;
+ }
+ $r = $r->previous;
+ }
+
+ my $referral = $request->clone;
+ #$referral->header('Extension' => "Security/Digest");
+ $referral->header($auth_header => $header);
+ return $self->request($referral, $arg, $size, $response);
+ } else {
+ return $response; # no password found
+ }
+ } else {
+ my $class = "LWP::Authen::$scheme";
+ eval "use $class ()";
+ if($@) {
+ warn $@;
+ warn "Authentication scheme '$scheme' not supported\n";
+ return $response;
+ }
+ return $class->authenticate($self, $response, $request, $arg, $size,
+ $scheme, $realm);
+ }
+ } else {
+ warn "Unknown challenge '$challenge'";
+ return $response;
+ }
+ }
1;
__END__