Authen-SASL
view release on metacpan or search on metacpan
lib/Authen/SASL/Perl/DIGEST_MD5.pm view on Meta::CPAN
my $qop = [ sort keys %{$self->{supported_qop}} ];
## get the realm using callbacks but default to the host specified
## during the instantiation of the SASL object
my $realm = $self->_call('realm');
$realm ||= $self->host;
my %response = (
nonce => $self->{nonce},
charset => 'utf-8',
algorithm => 'md5-sess',
realm => $realm,
maxbuf => $self->property('maxbuf'),
## IN DRAFT ONLY:
# If this directive is present multiple times the client MUST treat
# it as if it received a single qop directive containing a comma
# separated value from all instances. I.e.,
# 'qop="auth",qop="auth-int"' is the same as 'qop="auth,auth-int"
lib/Authen/SASL/Perl/DIGEST_MD5.pm view on Meta::CPAN
if (my @missing = grep { !exists $sparams{$_} } @server_required) {
return $self->set_error("Server did not provide required field(s): @missing")
}
my %response = (
nonce => $sparams{'nonce'},
cnonce => md5_hex($CNONCE || join (":", $$, time, rand)),
'digest-uri' => $self->service . '/' . $self->host,
# calc how often the server nonce has been seen; server expects "00000001"
nc => sprintf("%08d", ++$self->{nonce_counts}{$sparams{'nonce'}}),
charset => $sparams{'charset'},
);
return $self->set_error("Server qop too weak (qop = $sparams{'qop'})")
unless ($self->_client_layer(\%sparams,\%response));
# let caller-provided fields override defaults: authorization ID, service name, realm
my $s_realm = $sparams{realm} || [];
my $realm = $self->_call('realm', @$s_realm);
unless (defined $realm) {
t/digest_md5.t view on Meta::CPAN
my $conn = $sasl->client_new("ldap","localhost", "noplaintext noanonymous");
is($conn->mechanism, 'DIGEST-MD5', 'conn mechanism');
is($conn->client_start, '', 'client_start');
ok $conn->need_step, "we need extra steps";
ok !$conn->is_success, "success will be later if we are good boys";
ok !$conn->error, "so far so good";
my $sparams = 'realm="elwood.innosoft.com",nonce="OA6MG9tEQGm2hh",qop="auth,auth-inf",algorithm=md5-sess,charset=utf-8';
# override for testing as by default it uses $$, time and rand
$Authen::SASL::Perl::DIGEST_MD5::CNONCE = "foobar";
$Authen::SASL::Perl::DIGEST_MD5::CNONCE = "foobar"; # avoid used only once warning
my $initial = $conn->client_step($sparams);
ok $conn->need_step, "we need extra steps";
ok !$conn->is_success, "success will be later if we are good boys";
ok !$conn->error, "so far so good";
my @expect = qw(
charset=utf-8
cnonce="3858f62230ac3c915f300c664312c63f"
digest-uri="ldap/localhost"
nc=00000001
nonce="OA6MG9tEQGm2hh"
qop=auth
realm="elwood.innosoft.com"
response=9c81619e12f61fb2eed6bc8ed504ad28
username="gbarr"
);
t/digest_md5_verified.t view on Meta::CPAN
ok($sasl,'new');
is($sasl->mechanism, 'DIGEST-MD5', 'sasl mechanism');
my $conn = $sasl->client_new("sieve","imap.spodhuis.org", "noplaintext noanonymous");
is($conn->mechanism, 'DIGEST-MD5', 'conn mechanism');
is($conn->client_start, '', 'client_start');
my $sparams = 'nonce="YPymzyi3YH8OILTBvSIuaul7RD3fIANDT2akHE6auBE=",realm="imap.spodhuis.org",qop="auth",maxbuf=4096,charset=utf-8,algorithm=md5-sess';
# override for testing as by default it uses $$, time and rand
$Authen::SASL::Perl::DIGEST_MD5::CNONCE = "foobar";
$Authen::SASL::Perl::DIGEST_MD5::CNONCE = "foobar"; # avoid used only once warning
my $initial = $conn->client_step($sparams);
ok(!$conn->code(), "SASL error: " . ($conn->code() ? $conn->error() : ''));
my @expect = qw(
charset=utf-8
cnonce="3858f62230ac3c915f300c664312c63f"
digest-uri="sieve/imap.spodhuis.org"
nc=00000001
nonce="YPymzyi3YH8OILTBvSIuaul7RD3fIANDT2akHE6auBE="
qop=auth
realm="imap.spodhuis.org"
response=3743421076899a855bafec1f7a9ed58a
username="fred"
);
t/server/digest_md5.t view on Meta::CPAN
$Authen::SASL::Perl::DIGEST_MD5::NONCE = "foobaz";
is($sasl->mechanism, 'DIGEST-MD5', 'sasl mechanism');
my $server = $sasl->server_new("ldap","elwood.innosoft.com", { no_integrity => 1 });
is($server->mechanism, 'DIGEST-MD5', 'conn mechanism');
## simple success without authzid
{
my $expected_ss = join ",",
'algorithm=md5-sess',
'charset=utf-8',
'cipher="rc4,3des,des,rc4-56,rc4-40"',
'maxbuf=16777215',
'nonce="80338e79d2ca9b9c090ebaaa2ef293c7"',
'qop="auth"',
'realm="elwood.innosoft.com"';
my $ss;
$server->server_start('', sub { $ss = shift });
is($ss, $expected_ss, 'server_start');
my $c1 = join ",", qw(
charset=utf-8
cnonce="3858f62230ac3c915f300c664312c63f"
digest-uri="ldap/elwood.innosoft.com"
nc=00000001
nonce="80338e79d2ca9b9c090ebaaa2ef293c7"
qop=auth
realm="elwood.innosoft.com"
response=39ab7388b1f52492b1b87cda55177d04
username="gbarr"
);
t/server/digest_md5.t view on Meta::CPAN
ok !$server->error, "no error" or diag $server->error;
ok !$server->need_step, "over";
is $server->property('ssf'), 0, "auth doesn't provide any protection";
is($s1, "rspauth=dbf4b44d397bafd53be835344988ec9d", "rspauth matches");
}
# try with an authname
{
my $expected_ss = join ",",
'algorithm=md5-sess',
'charset=utf-8',
'cipher="rc4,3des,des,rc4-56,rc4-40"',
'maxbuf=16777215',
'nonce="80338e79d2ca9b9c090ebaaa2ef293c7"',
'qop="auth"',
'realm="elwood.innosoft.com"';
my $ss;
$server->server_start('', sub { $ss = shift });
is($ss, $expected_ss, 'server_start');
ok !$server->is_success, "not success yet";
ok !$server->error, "no error" or diag $server->error;
ok $server->need_step, "we need one more step";
$authname = 'meme';
my $c1 = join ",", qw(
authzid="meme"
charset=utf-8
cnonce="3858f62230ac3c915f300c664312c63f"
digest-uri="ldap/elwood.innosoft.com"
nc=00000002
nonce="80338e79d2ca9b9c090ebaaa2ef293c7"
qop=auth
realm="elwood.innosoft.com"
response=e01f51543754aa665cfa2c621d59ee9e
username="gbarr"
);
t/server/digest_md5.t view on Meta::CPAN
## using auth-conf (if available)
{
SKIP: {
skip "Crypt not available", 6
if $Authen::SASL::Perl::DIGEST_MD5::NO_CRYPT_AVAILABLE;
$server = $sasl->server_new("ldap","elwood.innosoft.com");
my $expected_ss = join ",",
'algorithm=md5-sess',
'charset=utf-8',
'cipher="rc4,3des,des,rc4-56,rc4-40"',
'maxbuf=16777215',
'nonce="80338e79d2ca9b9c090ebaaa2ef293c7"',
'qop="auth,auth-conf,auth-int"',
'realm="elwood.innosoft.com"';
my $ss;
$server->server_start('', sub { $ss = shift });
is($ss, $expected_ss, '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=e3c8b38d9bd9556761253e9879c4a8a2
username="gbarr"
);
t/server/digest_md5.t view on Meta::CPAN
## we have negociated the conf layer
ok $server->property('ssf') > 1, "yes! secure layer set up";
};
}
## wrong challenge response
{
$server = $sasl->server_new("ldap","elwood.innosoft.com");
$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"
);
t/server/digest_md5.t view on Meta::CPAN
like $server->error, qr/incorrect.*response/i, $server->error;
}
}
## multiple digest-uri;
{
$server = $sasl->server_new("ldap","elwood.innosoft.com");
$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"
);
t/server/digest_md5.t view on Meta::CPAN
ok !$server->is_success, "Bad challenge";
like $server->error, qr/Bad.*challenge/i, $server->error;
}
## nonce-count;
{
$server = $sasl->server_new("ldap","elwood.innosoft.com");
$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=e3c8b38d9bd9556761253e9879c4a8a2
username="gbarr"
);
( run in 0.248 second using v1.01-cache-2.11-cpan-fd5d4e115d8 )