| Subject: | PATCH: DIGEST-MD5 verification broken (was unimplemented) |
[This is a dup report of one sent to the maintenance mailing-list and
author on 2008-03-23]
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.
Please note: this is a security-critical bug since not only is it
failing to _allow_ a server identity verification bug, the library is
actively discouraging its dependent programs from correctly implementing
authentication with verification with a nett negative influence upon the
security of SASL-based authentication in Perl programs.
| Subject: | authen-sasl-digestmd5.patch |
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);
}