1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
|
use strict;
use warnings;
use Feature::Compat::Try;
package Authen::SASL::SCRAM;
=head1 NAME
Authen::SASL::SCRAM - SCRAM support for Authen::SASL
=head1 VERSION
0.04
=head1 SYNOPSIS
# with Authen::SASL::SCRAM installed
use Authen::SASL;
my $client = Authen::SASL->new(
username => 'user',
password => 'pass',
mechanism => 'SCRAM-SHA-512 SCRAM-SHA-256 SCRAM-SHA-1 PLAIN'
);
# authenticates using SCRAM SHA hash or PLAIN
my $salt = 'your-precious-salt';
# $server_key and $stored_key need to be looked up from a user store
my $server_key = 'server-key-stored-for-this-user';
my $stored_key = 'key-stored-for-this-user';
my $server => Authen::SASL->new(
mechanism => 'SCRAM-SHA-1', # selected mechanism
callback => {
getsecret => sub {
my $username = shift;
return ($salt, $stored_key, $server_key, $iterations);
},
}
);
=head1 DESCRIPTION
The C<Authen::SASL::SCRAM> distribution adds L<Authen::SASL> support for
SCRAM authentication using the mechanisms listed below by wrapping
L<Authen::SCRAM>.
=over
=item SHA-1 (SCRAM-SHA-1)
=item SHA-256 (SCRAM-SHA-256)
=item SHA-512 (SCRAM-SHA-512)
=back
The *-PLUS variants are not supported at this time.
=cut
use Authen::SASL;
use parent qw(Authen::SASL::Perl);
use Authen::SCRAM::Client;
use Authen::SCRAM::Server;
our @VERSION = '0.04';
my %secflags = (
noplaintext => 1,
noanonymous => 1,
);
sub _secflags {
shift;
scalar grep { $secflags{$_} } @_;
}
sub client_start {
my $self = shift;
$self->{need_step} = 2;
$self->{error} = undef;
my $user = $self->_call('user');
return $self->set_error( 'Username is required' )
unless defined $user;
my $pass = $self->_call('pass');
return $self->set_error( 'Password is required' )
unless defined $pass;
$self->{_client} = Authen::SCRAM::Client->new(
digest => $self->digest,
username => $user,
password => $pass,
);
return $self->{_client}->first_msg();
}
sub client_step {
my $self = shift;
my $challenge = shift;
$self->{need_step}--;
if ($self->{need_step} == 1) {
try {
return $self->{_client}->final_msg( $challenge );
}
catch ($e) {
return $self->set_error( 'Challenge failed (step 1)' );
}
}
else {
try {
return $self->{_client}->validate( $challenge );
}
catch ($e) {
return $self->set_error( 'Response failed (step 2)' );
}
}
}
sub mechanism {
my $self = shift;
return 'SCRAM-' . $self->digest;
}
sub server_start {
my $self = shift;
my $client_first = shift;
$self->{need_step} = 1;
$self->{_server} = Authen::SCRAM::Server->new(
digest => $self->digest,
credential_cb => $self->callback('getsecret')
);
try {
return $self->{_server}->first_msg( $client_first );
}
catch ($e) {
return $self->set_error( 'Client initiation failed' );
}
}
sub server_step {
my $self = shift;
my $client_final = shift;
$self->{need_step}--;
try {
my $rv = $self->{_server}->final_msg( $client_final );
$self->property( 'authname', $self->{_server}->authorization_id );
return $rv;
}
catch ($e) {
return $self->set_error( 'Client finalization failed' );
}
}
=head1 BUGS
Please report bugs via
L<https://github.com/ehuelsmann/authen-sasl-scram/issues>.
=head1 SEE ALSO
L<Authen::SASL>, L<Authen::SCRAM>
=head1 AUTHOR
Erik Huelsmann <ehuels@gmail.com>
=head1 COPYRIGHT
Copyright (c) 2023 Erik Huelsmann. All rights reserved. This program is
free software; you can redistribute it and/or modify it under the same
terms as Perl itself.
=cut
1;
|
