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"
    );