Current File : /home/opti/optisoftcom-new/perl/usr/lib/perl5/Authen/SCRAM/Client.pm
use 5.008;
use strict;
use warnings;
package Authen::SCRAM::Client;
# ABSTRACT: RFC 5802 SCRAM client
our $VERSION = '0.011';
use Moo 1.001000;
use Carp qw/croak/;
use Encode qw/encode_utf8/;
use MIME::Base64 qw/decode_base64/;
use PBKDF2::Tiny 0.003 qw/derive/;
use Try::Tiny;
use Types::Standard qw/Str Num/;
use namespace::clean;
#--------------------------------------------------------------------------#
# public attributes
#--------------------------------------------------------------------------#
#pod =attr username (required)
#pod
#pod Authentication identity. This will be normalized with the SASLprep algorithm
#pod before being transmitted to the server.
#pod
#pod =cut
has username => (
is => 'ro',
isa => Str,
required => 1,
);
#pod =attr password (required)
#pod
#pod Authentication password. This will be normalized with the SASLprep algorithm
#pod before being transmitted to the server.
#pod
#pod =cut
has password => (
is => 'ro',
isa => Str,
required => 1,
);
#pod =attr authorization_id
#pod
#pod If the authentication identity (C<username>) will act as a different,
#pod authorization identity, this attribute provides the authorization identity. It
#pod is optional. If not provided, the authentication identity is considered by the
#pod server to be the same as the authorization identity.
#pod
#pod =cut
has authorization_id => (
is => 'ro',
isa => Str,
default => '',
);
#pod =attr minimum_iteration_count
#pod
#pod If the server requests an iteration count less than this value, the client
#pod throws an error. This protects against downgrade attacks. The default is
#pod 4096, consistent with recommendations in the RFC.
#pod
#pod =cut
has minimum_iteration_count => (
is => 'ro',
isa => Num,
default => 4096,
);
# The derived PBKDF2 password can be reused if the salt and iteration count
# is the same as a previous authentication conversation.
has _cached_credentials => (
is => 'rw',
default => sub { [ "", 0, "" ] }, # salt, iterations, derived password
);
#--------------------------------------------------------------------------#
# provided by Authen::SCRAM::Role::Common
#--------------------------------------------------------------------------#
with 'Authen::SCRAM::Role::Common';
#pod =attr digest
#pod
#pod Name of a digest function available via L<PBKDF2::Tiny>. Valid values are
#pod SHA-1, SHA-224, SHA-256, SHA-384, or SHA-512. Defaults to SHA-1.
#pod
#pod =attr nonce_size
#pod
#pod Size of the client-generated nonce, in bits. Defaults to 192.
#pod The server-nonce will be appended, so the final nonce size will
#pod be substantially larger.
#pod
#pod =attr skip_saslprep
#pod
#pod A boolean that defaults to false. If set to true, usernames and passwords will
#pod not be normalized through SASLprep. This is a deviation from the RFC5802 spec
#pod and is not recommended.
#pod
#pod =cut
#--------------------------------------------------------------------------#
# private attributes
#--------------------------------------------------------------------------#
has _prepped_user => (
is => 'lazy',
isa => Str,
);
sub _build__prepped_user {
my ($self) = @_;
return $self->_saslprep( $self->username );
}
has _prepped_pass => (
is => 'lazy',
isa => Str,
);
sub _build__prepped_pass {
my ($self) = @_;
return $self->_saslprep( $self->password );
}
has _prepped_authz => (
is => 'lazy',
isa => Str,
);
sub _build__prepped_authz {
my ($self) = @_;
return $self->_saslprep( $self->authorization_id );
}
has _gs2_header => (
is => 'lazy',
isa => Str,
);
sub _build__gs2_header {
my ($self) = @_;
return $self->_construct_gs2( $self->_prepped_authz );
}
#--------------------------------------------------------------------------#
# public methods
#--------------------------------------------------------------------------#
#pod =method first_msg
#pod
#pod $client_first_msg = $client->first_msg();
#pod
#pod This takes no arguments and returns the C<client-first-message> character
#pod string to be sent to the server to initiate a SCRAM session. Calling this
#pod again will reset the internal state and initiate a new session. This will
#pod throw an exception should an error occur.
#pod
#pod =cut
sub first_msg {
my ($self) = @_;
$self->_clear_session;
$self->_set_session(
n => $self->_prepped_user,
r => $self->_get_session('_nonce'),
);
my $c_1_bare = $self->_join_reply(qw/n r/);
$self->_set_session( _c1b => $c_1_bare );
my $msg = $self->_gs2_header . $c_1_bare;
utf8::upgrade($msg); # ensure UTF-8 encoding internally
return $msg;
}
#pod =method final_msg
#pod
#pod $client_final_msg = $client->final_msg( $server_first_msg );
#pod
#pod This takes the C<server-first-message> character string received from the
#pod server and returns the C<client-final-message> character string containing the
#pod authentication proof to be sent to the server. This will throw an exception
#pod should an error occur.
#pod
#pod =cut
sub final_msg {
my ( $self, $s_first_msg ) = @_;
my ( $mext, @params ) = $s_first_msg =~ $self->_server_first_re;
if ( defined $mext ) {
croak
"SCRAM server-first-message required mandatory extension '$mext', but we do not support it";
}
if ( !@params ) {
croak "SCRAM server-first-message could not be parsed";
}
my $original_nonce = $self->_get_session("r");
$self->_parse_to_session(@params);
my $joint_nonce = $self->_get_session("r");
unless ( $joint_nonce =~ m{^\Q$original_nonce\E.} ) {
croak "SCRAM server-first-message nonce invalid";
}
# assemble client-final-wo-proof
$self->_set_session(
_s1 => $s_first_msg,
c => $self->_base64( encode_utf8( $self->_gs2_header ) ),
);
$self->_set_session( '_c2wop' => $self->_join_reply(qw/c r/) );
# assemble proof
my $salt = decode_base64( $self->_get_session("s") );
my $iters = $self->_get_session("i");
if ( $iters < $self->minimum_iteration_count ) {
croak sprintf( "SCRAM server requested %d iterations, less than the minimum of %d",
$iters, $self->minimum_iteration_count );
}
my ( $stored_key, $client_key, $server_key ) = $self->computed_keys( $salt, $iters );
$self->_set_session(
_stored_key => $stored_key,
_server_key => $server_key,
);
my $client_sig = $self->_client_sig;
$self->_set_session( p => $self->_base64( $client_key ^ $client_sig ) );
return $self->_join_reply(qw/c r p/);
}
#pod =method validate
#pod
#pod $client->validate( $server_final_msg );
#pod
#pod This takes the C<server-final-message> character string received from the
#pod server and verifies that the server actually has a copy of the client
#pod credentials. It will return true if valid and throw an exception, otherwise.
#pod
#pod =cut
sub validate {
my ( $self, $s_final_msg ) = @_;
my (@params) = $s_final_msg =~ $self->_server_final_re;
$self->_parse_to_session(@params);
if ( my $err = $self->_get_session("e") ) {
croak "SCRAM server-final-message was error '$err'";
}
my $server_sig =
$self->_hmac_fcn->( $self->_get_session("_server_key"), $self->_auth_msg );
if ( $self->_base64($server_sig) ne $self->_get_session("v") ) {
croak "SCRAM server-final-message failed validation";
}
return 1;
}
#pod =method computed_keys
#pod
#pod This method returns the opaque keys used in the SCRAM protocol. It returns
#pod the 'stored key', the 'client key' and the 'server key'. The server must
#pod have a copy of the stored key and server key for a given user in order to
#pod authenticate.
#pod
#pod This method caches the computed values -- it generates them fresh only if
#pod the supplied salt and iteration count don't match the cached salt and
#pod iteration count.
#pod
#pod =cut
sub computed_keys {
my ( $self, $salt, $iters ) = @_;
my $cache = $self->_cached_credentials;
if ( $cache->[0] eq $salt && $cache->[1] == $iters ) {
# return stored key, client key, server key
return @{$cache}[ 2 .. 4 ];
}
my $salted_pw =
derive( $self->digest, encode_utf8( $self->_prepped_pass ), $salt, $iters );
my $client_key = $self->_hmac_fcn->( $salted_pw, "Client Key" );
my $server_key = $self->_hmac_fcn->( $salted_pw, "Server Key" );
my $stored_key = $self->_digest_fcn->($client_key);
$self->_cached_credentials(
[ $salt, $iters, $stored_key, $client_key, $server_key ] );
return ( $stored_key, $client_key, $server_key );
}
1;
# vim: ts=4 sts=4 sw=4 et:
__END__
=pod
=encoding UTF-8
=head1 NAME
Authen::SCRAM::Client - RFC 5802 SCRAM client
=head1 VERSION
version 0.011
=head1 SYNOPSIS
use Authen::SCRAM::Client;
use Try::Tiny;
$client = Authen::SCRAM::Client->new(
username => 'johndoe',
password => 'trustno1',
);
try {
$client_first = $client->first_msg();
# send to server and get server-first-message
$client_final = $client->final_msg( $server_first );
# send to server and get server-final-message
$client->validate( $server_final );
}
catch {
die "Authentication failed!"
};
=head1 DESCRIPTION
This module implements the client-side SCRAM algorithm.
=head1 NAME
Authen::SCRAM::Client - RFC 5802 SCRAM client
=head1 VERSION
version 0.011
=head1 ATTRIBUTES
=head2 username (required)
Authentication identity. This will be normalized with the SASLprep algorithm
before being transmitted to the server.
=head2 password (required)
Authentication password. This will be normalized with the SASLprep algorithm
before being transmitted to the server.
=head2 authorization_id
If the authentication identity (C<username>) will act as a different,
authorization identity, this attribute provides the authorization identity. It
is optional. If not provided, the authentication identity is considered by the
server to be the same as the authorization identity.
=head2 minimum_iteration_count
If the server requests an iteration count less than this value, the client
throws an error. This protects against downgrade attacks. The default is
4096, consistent with recommendations in the RFC.
=head2 digest
Name of a digest function available via L<PBKDF2::Tiny>. Valid values are
SHA-1, SHA-224, SHA-256, SHA-384, or SHA-512. Defaults to SHA-1.
=head2 nonce_size
Size of the client-generated nonce, in bits. Defaults to 192.
The server-nonce will be appended, so the final nonce size will
be substantially larger.
=head2 skip_saslprep
A boolean that defaults to false. If set to true, usernames and passwords will
not be normalized through SASLprep. This is a deviation from the RFC5802 spec
and is not recommended.
=head1 METHODS
=head2 first_msg
$client_first_msg = $client->first_msg();
This takes no arguments and returns the C<client-first-message> character
string to be sent to the server to initiate a SCRAM session. Calling this
again will reset the internal state and initiate a new session. This will
throw an exception should an error occur.
=head2 final_msg
$client_final_msg = $client->final_msg( $server_first_msg );
This takes the C<server-first-message> character string received from the
server and returns the C<client-final-message> character string containing the
authentication proof to be sent to the server. This will throw an exception
should an error occur.
=head2 validate
$client->validate( $server_final_msg );
This takes the C<server-final-message> character string received from the
server and verifies that the server actually has a copy of the client
credentials. It will return true if valid and throw an exception, otherwise.
=head2 computed_keys
This method returns the opaque keys used in the SCRAM protocol. It returns
the 'stored key', the 'client key' and the 'server key'. The server must
have a copy of the stored key and server key for a given user in order to
authenticate.
This method caches the computed values -- it generates them fresh only if
the supplied salt and iteration count don't match the cached salt and
iteration count.
=for Pod::Coverage BUILD
=head1 CHARACTER ENCODING CAVEAT
The SCRAM protocol mandates UTF-8 interchange. However, all methods in this
module take and return B<character> strings. You must encode to UTF-8 before
sending and decode from UTF-8 on receiving according to whatever transport
mechanism you are using.
This is done to avoid double encoding/decoding problems if your transport is
already doing UTF-8 encoding or decoding as it constructs outgoing messages or
parses incoming messages.
=head1 AUTHOR
David Golden <dagolden@cpan.org>
=head1 COPYRIGHT AND LICENSE
This software is Copyright (c) 2014 by David Golden.
This is free software, licensed under:
The Apache License, Version 2.0, January 2004
=head1 AUTHOR
David Golden <dagolden@cpan.org>
=head1 COPYRIGHT AND LICENSE
This software is Copyright (c) 2014 by David Golden.
This is free software, licensed under:
The Apache License, Version 2.0, January 2004
=cut
Mini Shell