Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Browse files

revised server_new and the options that can be passed to it

takes a hash with no_integrity and no_confidentiality configurations.
  • Loading branch information...
commit 56442c43c0ca7b8ea38f0729868ea0c62f74f399 1 parent 9af51b5
@yannk yannk authored gbarr committed
View
2  lib/Authen/SASL.pod
@@ -122,7 +122,7 @@ Sets the given callbacks to the given values
Creates and returns a new connection object for a client-side connection.
-=item server_new ( SERVICE, HOST )
+=item server_new ( SERVICE, HOST, OPTIONS )
Creates and returns a new connection object for a server-side connection.
View
36 lib/Authen/SASL/Perl.pm
@@ -17,21 +17,31 @@ my %secflags = (
);
my %have;
-sub client_new {
- my $client = _new(@_);
- $client->_init_client(@_);
- return $client;
-}
sub server_new {
- my $server = _new(@_);
- $server->_init_server(@_);
- return $server;
-}
+ my ($pkg, $parent, $service, $host, $options) = @_;
-sub _init_server {}
-sub _init_client {}
+ my $self = {
+ callback => { %{$parent->callback} },
+ service => $service || '',
+ host => $host || '',
+ debug => $parent->{debug} || 0,
+ need_step => 1,
+ };
+
+ my $mechanism = $parent->mechanism
+ or croak "No server mechanism specified";
+ $mechanism =~ s/^\s*\b(.*)\b\s*$/$1/g;
+ $mechanism =~ s/-/_/g;
+ $mechanism = uc $mechanism;
+ my $mpkg = __PACKAGE__ . "::$mechanism";
+ eval "require $mpkg;"
+ or croak "Cannot use $mpkg for " . $parent->mechanism;
+ my $server = $mpkg->_init($self);
+ $server->_init_server($options);
+ return $server;
+}
-sub _new {
+sub client_new {
my ($pkg, $parent, $service, $host, $secflags) = @_;
my @sec = grep { $secflags{$_} } split /\W+/, lc($secflags || '');
@@ -58,6 +68,8 @@ sub _new {
$mpkg[0]->_init($self);
}
+sub _init_server {}
+
sub _order { 0 }
sub code { defined(shift->{error}) || 0 }
sub error { shift->{error} }
View
17 lib/Authen/SASL/Perl.pod
@@ -108,6 +108,23 @@ and should not be used without sufficient security protection.
=back
+As for server support, only I<PLAIN>, I<LOGIN> and I<DIGEST-MD5> are supported
+at the time of this writing.
+
+C<server_new> OPTIONS is a hashref that is only relevant for I<DIGEST-MD5> for
+now and it supports the following options:
+
+=over 4
+
+=item - no_integrity
+
+=item - no_confidentiality
+
+=back
+
+which configures how the security layers are negotiated with the client (or
+rather imposed to the client).
+
=head1 SEE ALSO
View
26 lib/Authen/SASL/Perl/DIGEST_MD5.pm
@@ -150,21 +150,27 @@ sub _init {
}
sub _init_server {
- my $server = shift;
+ my $server = shift;
+ my $options = shift || {};
+ if (!ref $options or ref $options ne 'HASH') {
+ warn "options for DIGEST_MD5 should be a hashref";
+ $options = {};
+ }
## new server, means new nonce_counts
$server->{nonce_counts} = {};
## determine supported qop
my @qop = ('auth');
- push @qop, 'auth-int' unless 0; ## options XXX in secflags
- push @qop, 'auth-conf' unless 0 or $NO_CRYPT_AVAILABLE; ## options
+ push @qop, 'auth-int' unless $options->{no_integrity};
+ push @qop, 'auth-conf' unless $options->{no_integrity}
+ or $options->{no_confidentiality}
+ or $NO_CRYPT_AVAILABLE;
+
my $qop = $SQOP || \@qop;
$server->{supported_qop} = { map { $_ => 1 } @$qop };
}
-sub _init_client { }
-
sub init_sec_layer {
my $self = shift;
$self->{cipher} = undef;
@@ -397,7 +403,7 @@ sub server_step {
my $qop = $cparams{'qop'} || "auth";
return $self->set_error("Client qop not supported (qop = '$qop')")
- unless $self->{supported_qop}{$qop};
+ unless $self->is_qop_supported($qop);
my $username = $cparams{'username'}
or return $self->set_error("Client didn't provide a username");
@@ -424,7 +430,7 @@ sub server_step {
unless defined $password;
## configure the security layer
- $self->_server_layer($cparams{qop} || "auth")
+ $self->_server_layer($qop)
or return $self->set_error("Cannot negociate the security layer");
my ($expected, $rspauth)
@@ -444,6 +450,12 @@ sub server_step {
return _response(\%response);
}
+sub is_qop_supported {
+ my $self = shift;
+ my $qop = shift;
+ return $self->{supported_qop}{$qop};
+}
+
sub _response {
my $response = shift;
my $is_client = shift;
View
2  t/login.t
@@ -1,6 +1,6 @@
#!perl
-use Test::More tests => 7;
+use Test::More tests => 6;
use Authen::SASL qw(Perl);
View
10 t/server/digest_md5.t
@@ -29,7 +29,7 @@ $Authen::SASL::Perl::DIGEST_MD5::NONCE = "foobaz";
$Authen::SASL::Perl::DIGEST_MD5::SQOP = [ "auth" ];
is($sasl->mechanism, 'DIGEST-MD5', 'sasl mechanism');
-my $server = $sasl->server_new("ldap","elwood.innosoft.com", "noplaintext noanonymous");
+my $server = $sasl->server_new("ldap","elwood.innosoft.com");
is($server->mechanism, 'DIGEST-MD5', 'conn mechanism');
## simple success without authzid
@@ -108,7 +108,7 @@ is($server->mechanism, 'DIGEST-MD5', 'conn mechanism');
## using auth-conf
{
$Authen::SASL::Perl::DIGEST_MD5::SQOP = [ "auth", "auth-int", "auth-conf" ];
- $server = $sasl->server_new("ldap","elwood.innosoft.com", "noplaintext noanonymous");
+ $server = $sasl->server_new("ldap","elwood.innosoft.com");
my $expected_ss = join ",",
'algorithm=md5-sess',
'charset=utf-8',
@@ -144,7 +144,7 @@ is($server->mechanism, 'DIGEST-MD5', 'conn mechanism');
## 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 = $sasl->server_new("ldap","elwood.innosoft.com");
$server->server_start('');
my $c1 = join ",", qw(
@@ -167,7 +167,7 @@ is($server->mechanism, 'DIGEST-MD5', 'conn mechanism');
## 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 = $sasl->server_new("ldap","elwood.innosoft.com");
$server->server_start('');
my $c1 = join ",", qw(
@@ -191,7 +191,7 @@ is($server->mechanism, 'DIGEST-MD5', 'conn mechanism');
## nonce-count;
{
$Authen::SASL::Perl::DIGEST_MD5::SQOP = [ "auth", "auth-int", "auth-conf" ];
- $server = $sasl->server_new("ldap","elwood.innosoft.com", "noplaintext noanonymous");
+ $server = $sasl->server_new("ldap","elwood.innosoft.com");
$server->server_start('');
my $c1 = join ",", qw(
Please sign in to comment.
Something went wrong with that request. Please try again.