Skip Menu |
 

This queue is for tickets about the libwww-perl CPAN distribution.

Report information
The Basics
Id: 35055
Status: resolved
Priority: 0/
Queue: libwww-perl

People
Owner: Nobody in particular
Requestors: zigorou [...] cpan.org
Cc:
AdminCc:

Bug Information
Severity: Critical
Broken in: 5.811
Fixed in: (no value)



Subject: Wrong treatment of qop value in Digest Authentication
Download (untitled) / with headers
text/plain 1.7k
I'd try digest authentication using by LWP::UserAgent. use LWP::UserAgent; my $ua = LWP::UserAgent->new; $ua->credentials('somehost:80', 'Realm string', 'username', 'password'); my $res = $ua->get("http://somehost/protected/index.html"); if ($res->is_success) { print $res->content; } else { print $res->status_line; } If the server response "auth,auth-int" as a 'qop' value, then LWP will be authentication failure whether or the pair of user id and password is correct. I'd read source code LWP::Authen::Digest, I'd found wrong code. The patch in below, *** ./lib/LWP/Authen/Digest.pm.orig 2008-04-15 16:01:12.000000000 +0900 --- ./lib/LWP/Authen/Digest.pm 2008-04-15 16:08:51.000000000 +0900 *************** *** 28,34 **** push(@digest, $auth_param->{nonce}); if ($auth_param->{qop}) { ! push(@digest, $nc, $cnonce, $auth_param->{qop}); } $md5->add(join(":", $request->method, $uri)); --- 28,34 ---- push(@digest, $auth_param->{nonce}); if ($auth_param->{qop}) { ! push(@digest, $nc, $cnonce, ($auth_param->{qop} =~ m|^auth[,;]auth-int$|) ? 'auth' : $auth_param->{qop}); } $md5->add(join(":", $request->method, $uri)); *************** *** 42,48 **** my %resp = map { $_ => $auth_param->{$_} } qw(realm nonce opaque); @resp{qw(username uri response algorithm)} = ($user, $uri, $digest, "MD5"); ! if (($auth_param->{qop} || "") eq "auth") { @resp{qw(qop cnonce nc)} = ("auth", $cnonce, $nc); } --- 42,48 ---- my %resp = map { $_ => $auth_param->{$_} } qw(realm nonce opaque); @resp{qw(username uri response algorithm)} = ($user, $uri, $digest, "MD5"); ! if (($auth_param->{qop} || "") =~ m|^auth[,;]auth-int$|) { @resp{qw(qop cnonce nc)} = ("auth", $cnonce, $nc); }
Subject: Digest.pm.patch
Download Digest.pm.patch
text/x-diff 1.2k
*** ./lib/LWP/Authen/Digest.pm.orig 2008-04-15 16:01:12.000000000 +0900 --- ./lib/LWP/Authen/Digest.pm 2008-04-15 16:08:51.000000000 +0900 *************** *** 28,34 **** push(@digest, $auth_param->{nonce}); if ($auth_param->{qop}) { ! push(@digest, $nc, $cnonce, $auth_param->{qop}); } $md5->add(join(":", $request->method, $uri)); --- 28,34 ---- push(@digest, $auth_param->{nonce}); if ($auth_param->{qop}) { ! push(@digest, $nc, $cnonce, ($auth_param->{qop} =~ m|^auth[,;]auth-int$|) ? 'auth' : $auth_param->{qop}); } $md5->add(join(":", $request->method, $uri)); *************** *** 42,48 **** my %resp = map { $_ => $auth_param->{$_} } qw(realm nonce opaque); @resp{qw(username uri response algorithm)} = ($user, $uri, $digest, "MD5"); ! if (($auth_param->{qop} || "") eq "auth") { @resp{qw(qop cnonce nc)} = ("auth", $cnonce, $nc); } --- 42,48 ---- my %resp = map { $_ => $auth_param->{$_} } qw(realm nonce opaque); @resp{qw(username uri response algorithm)} = ($user, $uri, $digest, "MD5"); ! if (($auth_param->{qop} || "") =~ m|^auth[,;]auth-int$|) { @resp{qw(qop cnonce nc)} = ("auth", $cnonce, $nc); }
Sorry, there are existed bug in my patch. I'd attached repaired code.
Download Digest.pm.patch
text/x-diff 1.2k
*** ./lib/LWP/Authen/Digest.pm.orig 2008-04-15 16:01:12.000000000 +0900 --- ./lib/LWP/Authen/Digest.pm 2008-04-15 17:23:01.000000000 +0900 *************** *** 28,34 **** push(@digest, $auth_param->{nonce}); if ($auth_param->{qop}) { ! push(@digest, $nc, $cnonce, $auth_param->{qop}); } $md5->add(join(":", $request->method, $uri)); --- 28,34 ---- push(@digest, $auth_param->{nonce}); if ($auth_param->{qop}) { ! push(@digest, $nc, $cnonce, ($auth_param->{qop} =~ m|^auth[,;]auth-int$|) ? 'auth' : $auth_param->{qop}); } $md5->add(join(":", $request->method, $uri)); *************** *** 42,48 **** my %resp = map { $_ => $auth_param->{$_} } qw(realm nonce opaque); @resp{qw(username uri response algorithm)} = ($user, $uri, $digest, "MD5"); ! if (($auth_param->{qop} || "") eq "auth") { @resp{qw(qop cnonce nc)} = ("auth", $cnonce, $nc); } --- 42,48 ---- my %resp = map { $_ => $auth_param->{$_} } qw(realm nonce opaque); @resp{qw(username uri response algorithm)} = ($user, $uri, $digest, "MD5"); ! if (($auth_param->{qop} || "") =~ m|^auth([,;]auth-int)?$|) { @resp{qw(qop cnonce nc)} = ("auth", $cnonce, $nc); }
The patch has now been applied. To appear in LWP-5.812. Thanks!


This service is sponsored and maintained by Best Practical Solutions and runs on Perl.org infrastructure.

Please report any issues with rt.cpan.org to rt-cpan-admin@bestpractical.com.