LWP::Authen::Digest update for RFC 2617

Dave Dunkin (dave_dunkin@hotmail.com)
19 Jan 2001 01:00:57 -0600 

--=-7lxDf58XCFLNmOS7KJ6+
Content-Type: text/plain

In a project I'm currently working on, I need to authenticate with an NT
server which specifies qop="auth" in the WWW-Authenticate header. The
included patch allows this to happen, as specified in RFC 2617.

Dave Dunkin

--=-7lxDf58XCFLNmOS7KJ6+
Content-Type: text/plain
Content-Disposition: attachment; filename=patch
Content-Transfer-Encoding: 7bit

--- Digest.pm.bak	Wed Jan 17 03:13:38 2001
+++ Digest.pm	Fri Jan 19 00:45:32 2001
@@ -3,6 +3,8 @@
 
 require MD5;
 
+my %nonce_count;
+
 sub authenticate
 {
     my($class, $ua, $proxy, $auth_param, $response,
@@ -12,6 +14,10 @@
                                                   $request->url, $proxy);
     return $response unless defined $user and defined $pass;
 
+    $nonce_count{$auth_param->{nonce}}++;
+    my $nc = sprintf "%08X", $nonce_count{$auth_param->{nonce}};
+    my $cnonce = sprintf "%8x", time;
+
     my $md5 = new MD5;
 
     my(@digest);
@@ -21,6 +27,10 @@
 
     push(@digest, $auth_param->{nonce});
 
+    if ($auth_param->{qop}) {
+	push(@digest, $nc, $cnonce, $auth_param->{qop});
+    }
+
     $md5->add(join(":", $request->method, $request->url->path));
     push(@digest, $md5->hexdigest);
     $md5->reset;
@@ -30,9 +40,13 @@
     $md5->reset;
 
     my %resp = map { $_ => $auth_param->{$_} } qw(realm nonce opaque);
-    @resp{qw(username uri response)} = ($user, $request->url->path, $digest);
+    @resp{qw(username uri response algorithm)} = ($user, $request->url->path, $digest, "MD5");
+
+    if($auth_param->{qop} eq "auth") {
+	@resp{qw(qop cnonce nc)} = ("auth", $cnonce, $nc);
+    }
 
-    my(@order) = qw(username realm nonce uri response);
+    my(@order) = qw(username realm qop algorithm uri nonce nc cnonce response);
     if($request->method =~ /^(?:POST|PUT)$/) {
 	$md5->add($request->content);
 	my $content = $md5->hexdigest;

--=-7lxDf58XCFLNmOS7KJ6+--