Permalink
Browse files

- Partly fixed digest-uri checking

- Added more unit tests
  • Loading branch information...
yannk authored and gbarr committed Jan 14, 2009
1 parent ac7b124 commit 9bc727d21d62829ec59f9474405abf94f57983a4
Showing with 69 additions and 9 deletions.
  1. +9 −3 lib/Authen/SASL/Perl/DIGEST_MD5.pm
  2. +13 −1 t/negotiations/digest-md5.t
  3. +47 −5 t/server/digest_md5.t
@@ -408,10 +408,16 @@ sub server_step {
}
my $authzid = $cparams{authzid};
- ## TODO: digest-uri
- # "Servers SHOULD check that the supplied value is correct. This will
- # detect accidental connection to the incorrect server, as well as
+ # digest-uri: "Servers SHOULD check that the supplied value is correct.
+ # This will detect accidental connection to the incorrect server, as well as
# some redirection attacks"
+ my $digest_uri = $cparams{'digest-uri'};
+ my ($cservice, $chost, $cservname) = split '/', $digest_uri, 3;
+ if ($cservice ne $self->service or $chost ne $self->host) {
+ # XXX deal with serv_name
+ return $self->set_error("Incorrect digest-uri");
+ }
+
my $realm = $cparams{'realm'};
my $password = $self->_call('pass', $username, $realm, $authzid);
@@ -1,7 +1,7 @@
#!perl
use strict;
use warnings;
-use Test::More tests => 9;
+use Test::More tests => 11;
use FindBin qw($Bin);
require "$Bin/../lib/common.pl";
@@ -66,3 +66,15 @@ negotiate($cconf, $sconf, sub {
like $srv->error, qr/response/, "incorrect response";
});
}
+
+## digest-uri checking
+{
+ local $cconf->{host} = "elsewhere";
+ local $cconf->{service} = "pop3";
+ negotiate($cconf, $sconf, sub {
+ my ($clt, $srv) = @_;
+ ok !$srv->is_success, "failure";
+ my $error = $srv->error || "";
+ like $error, qr/incorrect.*digest.*uri/i, "incorrect digest uri";
+ });
+}
View
@@ -8,7 +8,7 @@ BEGIN {
eval { require Digest::HMAC_MD5 } or Test::More->import(skip_all => 'Need Digest::HMAC_MD5');
}
-use Test::More (tests => 25);
+use Test::More (tests => 29);
use Authen::SASL qw(Perl);
use_ok 'Authen::SASL::Perl::DIGEST_MD5';
@@ -105,10 +105,6 @@ is($server->mechanism, 'DIGEST-MD5', 'conn mechanism');
is $server->property('ssf'), 0, "auth doesn't provide any protection";
}
-## wrong challenge response
-#{
-
-#}
## using auth-conf
{
$Authen::SASL::Perl::DIGEST_MD5::SQOP = [ "auth", "auth-int", "auth-conf" ];
@@ -144,3 +140,49 @@ is($server->mechanism, 'DIGEST-MD5', 'conn mechanism');
## we have negociated the conf layer
ok $server->property('ssf') > 1, "yes! secure layer set up";
}
+## wrong challenge response
+{
+ $Authen::SASL::Perl::DIGEST_MD5::SQOP = [ "auth", "auth-int", "auth-conf" ];
+ $server = $sasl->server_new("ldap","elwood.innosoft.com", "noplaintext noanonymous");
+ $server->server_start('');
+
+ my $c1 = join ",", qw(
+ charset=utf-8
+ cnonce="3858f62230ac3c915f300c664312c63f"
+ digest-uri="ldap/elwood.innosoft.com"
+ nc=00000001
+ nonce="80338e79d2ca9b9c090ebaaa2ef293c7"
+ qop=auth-conf
+ realm="elwood.innosoft.com"
+ response=nottherightone
+ username="gbarr"
+ );
+
+ my $s1 = $server->server_step($c1);
+ ok !$server->is_success, "Bad challenge";
+ like $server->error, qr/incorrect.*response/i, $server->error;
+}
+
+## multiple digest-uri;
+{
+ $Authen::SASL::Perl::DIGEST_MD5::SQOP = [ "auth", "auth-int", "auth-conf" ];
+ $server = $sasl->server_new("ldap","elwood.innosoft.com", "noplaintext noanonymous");
+ $server->server_start('');
+
+ my $c1 = join ",", qw(
+ charset=utf-8
+ cnonce="3858f62230ac3c915f300c664312c63f"
+ digest-uri="ldap/elwood.innosoft.com"
+ digest-uri="ldap/elwood.innosoft.com"
+ nc=00000001
+ nonce="80338e79d2ca9b9c090ebaaa2ef293c7"
+ qop=auth-conf
+ realm="elwood.innosoft.com"
+ response=e3c8b38d9bd9556761253e9879c4a8a2
+ username="gbarr"
+ );
+
+ my $s1 = $server->server_step($c1);
+ ok !$server->is_success, "Bad challenge";
+ like $server->error, qr/Bad.*challenge/i, $server->error;
+}

0 comments on commit 9bc727d

Please sign in to comment.