[prev in list] [next in list] [prev in thread] [next in thread] 

List:       perl-ldap-dev
Subject:    Authen::SASL DIGEST-MD5 verification bug
From:       Phil Pennock <pdp () spodhuis ! org>
Date:       2008-03-24 6:02:44
Message-ID: 20080324060244.GA70789 () redoubt ! spodhuis ! org
[Download RAW message or body]

[Attachment #2 (multipart/mixed)]


Folks,

The Perl native DIGEST-MD5 implementation for Authen::SASL doesn't
actually implement the second stage verification.  Instead, an attempt
to actually verify the server's second stage data results in:
  Server did not provide required field(s): algorithm nonce

That's a bogus complaint, since the server is only supposed to return
rspauth.

This means that anyone using Authen::SASL::Perl for DIGEST-MD5
authentication is getting an error if they actually implement the server
verification step.  That this hasn't been an issue before now is ...
rather worrying.

The attached patch fixes DIGEST-MD5 authentication.

Regards,
-Phil

["authen-sasl-digestmd5.patch" (text/x-diff)]

diff -ur Authen-SASL-2.10/lib/Authen/SASL/Perl/DIGEST_MD5.pm \
                Authen-SASL-new/lib/Authen/SASL/Perl/DIGEST_MD5.pm
--- Authen-SASL-2.10/lib/Authen/SASL/Perl/DIGEST_MD5.pm	Sat Mar 25 12:44:02 2006
+++ Authen-SASL-new/lib/Authen/SASL/Perl/DIGEST_MD5.pm	Sun Mar 23 22:51:16 2008
@@ -41,6 +41,7 @@
 {
   my ($self, $challenge) = @_;
   $self->{server_params} = \my %sparams;
+  $self->{challenge_count} = 0 unless exists $self->{challenge_count};
 
   # Parse response parameters
   while($challenge =~ s/^(?:\s*,)?\s*(\w+)=("([^\\"]+|\\.)*"|[^,]+)\s*//) {
@@ -63,13 +64,38 @@
   return $self->set_error("Bad challenge: '$challenge'")
     if length $challenge;
 
+  $self->{challenge_count} += 1;
+
   # qop in server challenge is optional: if not there "auth" is assumed
   return $self->set_error("Server does not support auth (qop = $sparams{'qop'})")
     if ($sparams{qop} && ! grep { /^auth$/ } split(/,/, $sparams{'qop'}));
 
-  # check required fields in server challenge
+  # check required fields in server challenge, but only on first iteration
   if (my @missing = grep { !exists $sparams{$_} } @required) {
-    return $self->set_error("Server did not provide required field(s): @missing")
+    if ($self->{challenge_count} < 2) {
+      return $self->set_error("Server did not provide required field(s): @missing")
+    }
+  }
+
+  if ($self->{challenge_count} > 2) {
+    return $self->set_error("Too many challenge iterations for DIGEST-MD5");
+  }
+  if ($self->{challenge_count} == 2) {
+    unless (exists $sparams{'rspauth'}) {
+      return $self->set_error("Missing second stage rspauth data");
+    }
+    foreach my $k ('digest_uri', 'response_prefix') {
+      unless (exists $self->{$k}) {
+	return $self->set_error("Lost our $k field");
+      }
+    }
+    my $step3_A2 = ':' . $self->{'digest_uri'};
+    # If supporting protection layers, there's an extra field here
+    my $step3 = md5_hex($self->{'response_prefix'} . md5_hex($step3_A2));
+    if ($sparams{'rspauth'} ne $step3) {
+      return $self->set_error("Server failed final verification.");
+    }
+    return '';
   }
 
   my %response = (
@@ -126,9 +152,11 @@
   $A2 .= ":00000000000000000000000000000000"
     if $response{'qop'} and $response{'qop'} =~ /^auth-(conf|int)$/;
 
-  $response{'response'} = md5_hex(
-    join (":", md5_hex($A1), @response{qw(nonce nc cnonce qop)}, md5_hex($A2))
-  );
+  my $response_prefix = join (":", md5_hex($A1), @response{qw(nonce nc cnonce qop)}, \
''); +  $response{'response'} = md5_hex($response_prefix . md5_hex($A2));
+
+  $self->{digest_uri} = $response{'digest-uri'};
+  $self->{response_prefix} = $response_prefix;
 
   join (",", map { _qdval($_, $response{$_}) } sort keys %response);
 }


[Attachment #6 (application/pgp-signature)]

[prev in list] [next in list] [prev in thread] [next in thread]